Création d'un block par calque

[Fredxxx]

Bonsoir,

 

Je ne connais rien dans la création de lisp, et j'avoue que je galère énormément.

 

Je souhaite créer/adapter une routine qui me permettrait de créer un bloc par calque existant dans mon dessin. Les blocs prendraient comme nom le nom des calques et seraient composés des éléments dessinés sur chaque calque.

 

Manuellement dans Autocad (2016 pour ma part) ça ne prend pas beaucoup de temps mais je suis amené à le faire de façon récurrente et sur des fichiers qui peuvent contenir quelques dizaines de calques. Et là je me dis qu'il faut automatiser la chose.

 

J'ai cherché sur les différents sujets, et essayé de bricoler qqch mais c'est un vrai carnage.

 

Auriez-vous quelque chose qui se rapprocherait de mon besoin et que je pourrais adapter ?

 

Merci d'avance pour vos retours

[lecrabe]

Hello

 

Voir la routine "LAYERTODWG_2" ci-apres du Grand Maitre Gilles ! ... Pas tout a fait ce que tu desires !?

 

Elle cree un DWG (par un WBLOC) pour chaque calque selectionne !

 

Donc une petite adaptation permettrait de faire un BLOC, Inserer le Bloc sur le calque ...

 

Par contre il y a un truc important, on re-insere bien chaque Bloc sur le calque en cours !?

Et QUID du point d insertion ?!

 

Dans l 'attente d un Pro du Lisp / VLisp ... Gilles par exemple ?

 

LA SANTE, Bye, lecrabe

 

;;
;; LAYERTODWG par GC version 2.0
;; Crée un fichier DWG pour chaque calque sélectionné
;; Commande au clavier :  LAYERTODWG_2
;; ATTENTION: svp verifier votre systeme d'unites
;; 

(defun c:LayerToDwg_2 (/ acdoc layers prefix name llst ss)
 (vl-load-com)
 (setq acdoc  (vla-get-ActiveDocument (vlax-get-acad-object))
       layers (vla-get-Layers acdoc)
       prefix (getvar 'dwgprefix)
 )
 (vlax-for l layers
   (setq name (vla-get-Name l))
   (if (not (wcmatch name "*|*"))
     (setq llst (cons name llst))
   )
 )
 (setq llst (vl-sort llst '<)
       llst (ListBox "LayerToDwg"
                "Sélectionnez les calques à traiter"
                (mapcar 'cons llst llst)
                2
       )
 ) 

 (foreach name llst
   (if (ssget "_X" (list '(410 . "Model") (cons 8 name)))
     (progn
       (setq ss (vla-get-ActiveSelectionSet acdoc)) 

       (vla-Wblock acdoc (strcat prefix name ".dwg") ss)  ;; WBLOC du calque 

       (vla-delete ss)  ;; Effacement du contenu du calque 

     )
   )

 )
 (princ)
)

;; ListBox (gile)
;; Boite de dialogue permettant un ou plusieurs choix dans une liste
;;
;; Arguments
;; title : le titre de la boite de dialogue (chaîne)
;; msg ; message (chaîne), "" ou nil pour aucun
;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...)
;; flag : 0 = liste déroulante
;;        1 = liste choix unique
;;        2 = liste choix multipes
;;
;; Retour : la clé de l'option (flag = 0 ou 1) ou la liste des clés des options (flag = 2)
;;
;; Exemple d'utilisation
;; (listbox "Présentation" "Choisir une présentation" (mapcar 'cons (layoulist) (layoutlist)) 1)

(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
 (setq	tmp  (vl-filename-mktemp "tmp.dcl")
file (open tmp "w")
 )
 (write-line
   (strcat "ListBox:dialog{label=\"" title "\";")
   file
 )
 (if (and msg (/= msg ""))
   (write-line (strcat ":text{label=\"" msg "\";}") file)
 )
 (write-line
   (cond
     ((= 0 flag) "spacer;:popup_list{key=\"lst\";")
     ((= 1 flag) "spacer;:list_box{key=\"lst\";")
     (T "spacer;:list_box{key=\"lst\";multiple_select=true;")
   )
   file
 )
 (write-line "}spacer;ok_cancel;}" file)
 (close file)
 (setq dcl_id (load_dialog tmp))
 (if (not (new_dialog "ListBox" dcl_id))
   (exit)
 )
 (start_list "lst")
 (mapcar 'add_list (mapcar 'cdr keylab))
 (end_list)
 (action_tile
   "accept"
   "(or (= (get_tile \"lst\") \"\")
   (if (= 2 flag) (progn
   (foreach n (str2lst (get_tile \"lst\") \" \")
   (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice)))
   (setq choice (reverse choice)))
   (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))))
   (done_dialog)"
 )
 (start_dialog)
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 choice
)

;; str2lst
;; Transforme un chaine avec séparateur en liste de chaines
;;
;; Arguments
;; str : la chaine à transformer en liste
;; sep : le séparateur
;;
;; Exemples
;; (str2lst "a b c" " ") -> ("a" "b" "c")
;; (str2lst "1,2,3" ",") -> ("1" "2" "3")
;; (mapcar 'read (str2lst "1,2,3" ",")) -> (1 2 3)

(defun str2lst (str sep / pos)
 (if (setq pos (vl-string-search sep str))
   (cons (substr str 1 pos)
  (str2lst (substr str (+ (strlen sep) pos 1)) sep)
   )
   (list str)
 )
)

[Fraid]

bonjour,

 

je t'ai fait cela

 

(defun c:lay2blk ( / acdc pt lay lvlay clay blk objs)
   (setq acdc (vla-get-activedocument (vlax-get-acad-object))
         pt (vlax-3d-point '(0 0 0))
         lvlay (vla-get-layers acdc)
         clay (vla-get-activelayer acdc)
   )
   (vlax-for vlay lvlay
       (if (null(wcmatch (setq lay (vla-get-name vlay)) "0,*|*"))
         (progn
           (vla-put-activelayer acdc (vla-item lvlay lay))
           (setq blk (vla-add (vla-get-blocks acdc) pt lay) objs nil)
           (vlax-for obj (vla-get-modelspace acdc)
               (if (= lay (vla-get-layer obj))
                   (setq objs (cons obj objs))
               )
           )
           (vla-copyobjects acdc 
                            (vlax-safearray-fill (vlax-make-safearray vlax-vbObject (cons 0 (1- (length objs)))) objs)
                            blk
           )
           (mapcar 'vla-delete objs)
           (vla-insertblock (vla-get-modelspace acdc) pt lay 1 1 1 0)
         )
       )
       
   )
   (vla-put-activelayer acdc (vla-item lvlay (vla-get-name clay)))
   (princ)
)

 

le point d'insertion des blocs est 0,0,0

les objets d'origines sont effacés

Modifié le 2 février 2021 par Fraid

[Luna]

Coucou,

 

En complément de la routine de Fraid, il existe ces deux routines de Lee Mac qui sont très utiles : http://www.lee-mac.com/changeblockinsertion.html.

Cela te permettra de modifier le point d'insertion de tes blocs si le point 0,0,0 n'est pas correctement adapté.

 

Une autre solution serait de calculer la boundingbox de la sélection par layer pour déterminer le point central de cette boundingbox. Cependant, il me semble qu'il faut avoir un jeu de sélection et je ne m'y connais pas suffisamment en Visual pour modifier la routine de Fraid afin d'incorporer le calcul de Lee Mac pour la BoundingBox...

 

 

Bisous,

Luna

[Fraid]

Bonjour luna,

 

je ne me suis pas attardé sur le point d'insertion, c'est à lui de nous dire ou il le veut.

et il faudrait faire aussi un contrôle du scu avant.

peut etre qu'un simple getpoint suffit.

je ne me suis pas occupé non plus des calques éventuellement gelés ou verrouillés.

et si il faut supprimer les objets à la fin

je privilégie le vla dans ce type de routines qui peut être appelé à manipuler beaucoup d'objets.

Sinon, je vais souvent chez Lee, cela doit se voir dans mon code.

[GEGEMATIC]

Elle est très stylée, ta routine, compacte au maximum !

[Luna]

Bonjour luna,

 

je ne me suis pas attardé sur le point d'insertion, c'est à lui de nous dire ou il le veut.

et il faudrait faire aussi un contrôle du scu avant.

peut etre qu'un simple getpoint suffit.

je ne me suis pas occupé non plus des calques éventuellement gelés ou verrouillés.

et si il faut supprimer les objets à la fin

je privilégie le vla dans ce type de routines qui peut être appelé à manipuler beaucoup d'objets.

Sinon, je vais souvent chez Lee, cela doit se voir dans mon code.

 

Vouih absolument, le reste c'est de la fioriture pour du confort utilisateur :3

Mais je reconnais bien l'utilité du Visual sur certaines tâches qui ont le mérite d'être assez compactes à l'écriture.

 

Bisous,

Luna

[Fredxxx]

Hello

 

Voir la routine "LAYERTODWG_2" ci-apres du Grand Maitre Gilles ! ... Pas tout a fait ce que tu desires !?

 

Elle cree un DWG (par un WBLOC) pour chaque calque selectionne !

 

Donc une petite adaptation permettrait de faire un BLOC, Inserer le Bloc sur le calque ...

 

Par contre il y a un truc important, on re-insere bien chaque Bloc sur le calque en cours !?

Et QUID du point d insertion ?!

 

Dans l 'attente d un Pro du Lisp / VLisp ... Gilles par exemple ?

 

LA SANTE, Bye, lecrabe

 

;;
;; LAYERTODWG par GC version 2.0
;; Crée un fichier DWG pour chaque calque sélectionné
;; Commande au clavier :  LAYERTODWG_2
;; ATTENTION: svp verifier votre systeme d'unites
;; 

(defun c:LayerToDwg_2 (/ acdoc layers prefix name llst ss)
 (vl-load-com)
 (setq acdoc  (vla-get-ActiveDocument (vlax-get-acad-object))
       layers (vla-get-Layers acdoc)
       prefix (getvar 'dwgprefix)
 )
 (vlax-for l layers
   (setq name (vla-get-Name l))
   (if (not (wcmatch name "*|*"))
     (setq llst (cons name llst))
   )
 )
 (setq llst (vl-sort llst '<)
       llst (ListBox "LayerToDwg"
                "Sélectionnez les calques à traiter"
                (mapcar 'cons llst llst)
                2
       )
 ) 

 (foreach name llst
   (if (ssget "_X" (list '(410 . "Model") (cons 8 name)))
     (progn
       (setq ss (vla-get-ActiveSelectionSet acdoc)) 

       (vla-Wblock acdoc (strcat prefix name ".dwg") ss)  ;; WBLOC du calque 

       (vla-delete ss)  ;; Effacement du contenu du calque 

     )
   )

 )
 (princ)
)

;; ListBox (gile)
;; Boite de dialogue permettant un ou plusieurs choix dans une liste
;;
;; Arguments
;; title : le titre de la boite de dialogue (chaîne)
;; msg ; message (chaîne), "" ou nil pour aucun
;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...)
;; flag : 0 = liste déroulante
;;        1 = liste choix unique
;;        2 = liste choix multipes
;;
;; Retour : la clé de l'option (flag = 0 ou 1) ou la liste des clés des options (flag = 2)
;;
;; Exemple d'utilisation
;; (listbox "Présentation" "Choisir une présentation" (mapcar 'cons (layoulist) (layoutlist)) 1)

(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
 (setq	tmp  (vl-filename-mktemp "tmp.dcl")
file (open tmp "w")
 )
 (write-line
   (strcat "ListBox:dialog{label=\"" title "\";")
   file
 )
 (if (and msg (/= msg ""))
   (write-line (strcat ":text{label=\"" msg "\";}") file)
 )
 (write-line
   (cond
     ((= 0 flag) "spacer;:popup_list{key=\"lst\";")
     ((= 1 flag) "spacer;:list_box{key=\"lst\";")
     (T "spacer;:list_box{key=\"lst\";multiple_select=true;")
   )
   file
 )
 (write-line "}spacer;ok_cancel;}" file)
 (close file)
 (setq dcl_id (load_dialog tmp))
 (if (not (new_dialog "ListBox" dcl_id))
   (exit)
 )
 (start_list "lst")
 (mapcar 'add_list (mapcar 'cdr keylab))
 (end_list)
 (action_tile
   "accept"
   "(or (= (get_tile \"lst\") \"\")
   (if (= 2 flag) (progn
   (foreach n (str2lst (get_tile \"lst\") \" \")
   (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice)))
   (setq choice (reverse choice)))
   (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))))
   (done_dialog)"
 )
 (start_dialog)
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 choice
)

;; str2lst
;; Transforme un chaine avec séparateur en liste de chaines
;;
;; Arguments
;; str : la chaine à transformer en liste
;; sep : le séparateur
;;
;; Exemples
;; (str2lst "a b c" " ") -> ("a" "b" "c")
;; (str2lst "1,2,3" ",") -> ("1" "2" "3")
;; (mapcar 'read (str2lst "1,2,3" ",")) -> (1 2 3)

(defun str2lst (str sep / pos)
 (if (setq pos (vl-string-search sep str))
   (cons (substr str 1 pos)
  (str2lst (substr str (+ (strlen sep) pos 1)) sep)
   )
   (list str)
 )
)

 

 

Oui j'avais aperçu ce lisp mais ce n'était pas ce dont j'avais besoin.

 

En effet mon objectif est de réinsérer le bloc créé dans le document sur le calque en cours ou sur le 0, cela n'a pas d'importance.

L'origine du bloc restant a l'origine du dessin

 

Merci pour la proposition, et la rapidité B)

[Fredxxx]

bonjour,

 

je t'ai fait cela

 

(defun c:lay2blk ( / acdc pt lay lvlay clay blk objs)
   (setq acdc (vla-get-activedocument (vlax-get-acad-object))
         pt (vlax-3d-point '(0 0 0))
         lvlay (vla-get-layers acdc)
         clay (vla-get-activelayer acdc)
   )
   (vlax-for vlay lvlay
       (if (null(wcmatch (setq lay (vla-get-name vlay)) "0,*|*"))
         (progn
           (vla-put-activelayer acdc (vla-item lvlay lay))
           (setq blk (vla-add (vla-get-blocks acdc) pt lay) objs nil)
           (vlax-for obj (vla-get-modelspace acdc)
               (if (= lay (vla-get-layer obj))
                   (setq objs (cons obj objs))
               )
           )
           (vla-copyobjects acdc 
                            (vlax-safearray-fill (vlax-make-safearray vlax-vbObject (cons 0 (1- (length objs)))) objs)
                            blk
           )
           (vla-insertblock (vla-get-modelspace acdc) pt lay 1 1 1 0)
         )
       )
       
   )
   (vla-put-activelayer acdc (vla-item lvlay (vla-get-name clay)))
   (princ)
)

 

le point d'insertion des blocs est 0,0,0

les objets d'origines ne sont pas effacer

 

 

Merci Fraid,

ta routine est presque parfaite, en effet j'avais oublié de préciser que je souhaitais que les éléments sélectionnés soient convertis en bloc. Tu as moyen de modifier ton code initial ?

 

Dans mes recherches je n'avais même pas vu qu'il existait une autre façon de coder le lisp en utilisant le vla. C'est du dérivé de VB ? J'essayerai de regarder ce soir sur les différents liens fournis par Luna pour me documenter encore un peu plus à ce sujet.

[Fraid]

Yop

 

J'ai modifié le code plus haut, les objets sont cette fois effacés.

C'est du dérivé de VB ?

 

du tout, C'est une version lisp qui permet d’accéder aux objets activex.

Si tu est débutant en Autolisp, il ne faut pas commencer par la.

Tout d'abord de l'Autolisp "pur"

je te conseil la page de gile

Mon lien

et l'aide du développer

puis du courage et de la persévérance.

[Fredxxx]

ok merci, je vais tester demain.

 

J'ai passé une bonne partie de la soirée a essayer de décrypter les différents fonctions de ton code via l'aide Autocad en ligne et en lisant en // les tutos de Lee Mac. Eh bien... ça fait mal :blink:

 

De mes yeux d'enfant codeur tu as rajouté la ligne "(mapcar 'vla-delete objs)" qui efface les objets présents dans le calque avant d'insérer le bloc précédemment créé...?

 

Pour créer mon lisp j'avais en tête de :

faire une boucle sur chacun des calques avec les fonction TABLENEXT et FOREACH qui ferait

- une sélection d'objets par attribut (=nom du calque sélectionné)

- lancer la commande "bloc" avec les options point d'insertion à 0,0,0 et "ne pas conserver les objets"

 

Selon toi c'était jouable ou directement voué à l'échec ?

[Fraid]

"(mapcar 'vla-delete objs)" qui efface les objets présents dans le calque

 

Tout à fait.

 

la variable objs est une liste d'objet vla.

mapcar applique la fonction vla-delete à chaque élément de la liste

 

sinon, commence par des programmes plus simple.

la création de bloc, même en autolisp, n'est pas facile.

et une suite de command n'est pas vraiment un programme mais plus un script ou une macro.

une piste

pour sélectionner tout les objet d'un calque dans l'espace objet. ici le calque "0"

(setq sel (ssget "_x" (list (cons 8 "0")(cons 410 "MODEL"))))

déjà essaye de comprendre ceci

bon courage

[Fredxxx]

Routine testée et approuvée, un grand merci, tu me fais gagner un temps précieux.

 

En effet j'ai bien compris que les macros, les scripts et l'Autolisp sont différents dans la logique.

 

Je vais continuer à regarder le fonctionnement du Lisp et essayer de bricoler quelques fonctions déjà existantes tel le petit chimiste. Mais je me rends compte qu'il va falloir s'accrocher et en faire régulièrement pour être un minimum performant.