Petit Complement

[willy95]

Bonjour a tous,

Après avoir chercher pas mal de temps et sans trouver, je cherche a completer le lisp de Gile,

l'idéal serait de recupérer la valeur du texte dans l'etiquette ALT et

incrémenter automatiquement un numero de point dans une etiquette NUM.

De plus je souhaiterais avoir un calque différent pour les numéros, un pour les Altitudes et un calque point pour le point d'insertion.

(defun c:txt2blk (/ *error* makeblock ss spc)
 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (or *blocks* (setq *blocks* (vla-get-Blocks *acdoc*)))

 ;;---------------------------------------------------;;

 (defun *error* (msg)
   (or (= msg "Fonction annulée")
       (princ (strcat "Erreur: " msg))
   )
   (vla-EndUndoMark *acdoc*)
   (princ)
 )

 ;;---------------------------------------------------;;

 ;; MakeBlock
 ;; Crée le bloc PointBloc
 (defun makeblock (/ block)
   (vl-load-com)
   (setq block (vla-add *blocks*
                        (vlax-3d-point '(0. 0. 0.))
                        "bloc_point"
               )
   )
   (vla-put-Layer
     (vla-addPoint block (vlax-3d-point '(0. 0. 0.)))
     "0"
   )
   (vla-put-Layer
     (vla-addAttribute
       block
       0.65
       acAttributeModePreset
       ""
       (vlax-3d-point '(0. 0. 0.))
       "ALT"
       ""
     )
     "0"
   )
   block
 )

 ;;---------------------------------------------------;;

 (princ "\nSélectionnez les textes ou valider pour tous.")
 (if (or (ssget '((0 . "TEXT")))
         (ssget "_X" (list '(0 . "TEXT") (cons 410 (getvar 'ctab))))
     )
   (progn
     (vla-StartUndoMark *acdoc*)
     (or (tblsearch "BLOCK" "bloc_point") (makeblock))
     (setq spc (if (= 1 (getvar 'cvport))
                 (vla-get-PaperSpace *acdoc*)
                 (vla-get-ModelSpace *acdoc*)
               )
     )
     (vlax-for txt (setq ss (vla-get-ActiveSelectionSet *acdoc*))
       (setq ins (vlax-get txt 'InsertionPoint)
             str (vla-get-TextString txt)
             blk
                 (vla-InsertBlock
                   spc
                   (vlax-3d-point (car ins) (cadr ins) (atof str))
                   "bloc_point"
                   1.
                   1.
                   1.
                   (vla-get-Rotation txt)
                 )
       )
       (vla-put-Layer blk (vla-get-Layer txt))
       (vla-put-TextString (car (vlax-invoke blk 'GetAttributes)) str)
       (vla-delete txt)
     )
     (vla-delete ss)
     (vla-EndUndoMark *acdoc*)
   )
 )
 (princ)
)

 

Merci d'avance pour vos suggestion.