macro pour sélectionner plusieurs blocs

Kegaska · le 18 novembre 2020

Bonjour,

Je reprends à partir du début.

A la place de sélection rapide : si tes blocs à sélectionner ont un préfixe/suffixe/chaine en commun, tu peux utiliser la commande FILTRE pour les sélectionner tous d'un coup.

Curlygoth · le 18 novembre 2020

voila en piece jointe !!!

Vu que je sais pas comment tu va gérer tes calques par sélection, il seront dans un calque avec le nom du fichier et le nom du bloc

le code

^c^c^p-vbarun "TON...DOSSIER\SEL_OBJ_V_AUTRE_PLAN_0.dvb!M_BLOC.IMPORT_BLOC_XREF"

est a mettre pour creer un bouton et a la place de TON...DOSSIER tu ecris le chemin d'acces reel avec des "\"

si tu souhaites un code plus complet pour te faire des rapports automatique ou autre contacte moi en MP ou via mon site ;-)

(verifi avant je pense qu'il y a un pobleme dans la generation des calques)

je te corrige ça

EDIT : SUPPRESSION DU PROGRAMME un peu buggué

Jbrosteaux · le 18 novembre 2020

voila en piece jointe !!!

Vu que je sais pas comment tu va gérer tes calques par sélection, il seront dans un calque avec le nom du fichier et le nom du bloc
le code
^c^c^p-vbarun "TON...DOSSIER\SEL_OBJ_V_AUTRE_PLAN_0.dvb!M_BLOC.IMPORT_BLOC_XREF"
est a mettre pour creer un bouton et a la place de TON...DOSSIER tu ecris le chemin d'acces reel avec des "\"

si tu souhaites un code plus complet pour te faire des rapports automatique ou autre contacte moi en MP ou via mon site ;-)

(verifi avant je pense qu'il y a un pobleme dans la generation des calques)

je te corrige ça

Hey salut,

Je vais installer tout sa quand je rentre et je te dis quoi.

Merci

Jbrosteaux · le 18 novembre 2020

voila en piece jointe !!!

Vu que je sais pas comment tu va gérer tes calques par sélection, il seront dans un calque avec le nom du fichier et le nom du bloc
le code
^c^c^p-vbarun "TON...DOSSIER\SEL_OBJ_V_AUTRE_PLAN_0.dvb!M_BLOC.IMPORT_BLOC_XREF"
est a mettre pour creer un bouton et a la place de TON...DOSSIER tu ecris le chemin d'acces reel avec des "\"

si tu souhaites un code plus complet pour te faire des rapports automatique ou autre contacte moi en MP ou via mon site ;-)

(verifi avant je pense qu'il y a un pobleme dans la generation des calques)

je te corrige ça

J'ai chargé ta macro VBA mais une fois que je veux l'exécuté il indique qu'il y a une erreur de comptabilité.

J'ai autocad 2018 full

Curlygoth · le 18 novembre 2020

je t'ai mis la version corrigé !

Heu... je t'envoie le code complet en mp ?

SEL_OBJ_V_AUTRE_PLAN_0.zip

Jbrosteaux · le 18 novembre 2020

je t'ai mis la version corrigé !

Heu... je t'envoie le code complet en mp ?

Salut,

Oui tu peux m'envoyer en message privé.

Actuellement quand je le charge j'ai ceci qui apparait:

Erreur de compilation dans le module caché: M_Bloc

Cette erreur se produit généralement lorsque le code est incompatible avec la version, plateforme ou architecture de cette application.

(gile) · le 18 novembre 2020

Salut,

Essaye ça.

Tu charges le LISP dans le dessin source, tu lances la commande COPYTODWG, tu choisis le dessin cible (il doit être fermé) et c'est tout.

Remplace "XXX,YYY" par les noms de blocs à sélectionner (séparés par une virgule).

(vl-load-com)
(or *acad* (setq *acad* (vlax-get-acad-object)))
(or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))

(defun c:copyToDwg (/ progId majVer ss filename axdbdoc i blocs)
 (if
   (and
     (setq ss (ssget "_X" '((0 . "INSERT") (410 . "Model") (2 . "XXX,YYY")))) ; <- remplacer "XXX,YYY" par les noms de blocs
     (setq filename (getfiled "Fichier cible" "" "dwg" 0))
     (setq progId (if (< (setq majVer (substr (getvar 'acadver) 1 2)) "16")
	     "ObjectDBX.AxDbDocument"
	     (strcat "ObjectDBX.AxDbDocument." majVer)
	   )
     )
     (setq axdbdoc (vla-GetInterfaceObject *acad* progId))
     (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list axdbdoc filename))))
   )
    (progn
      (repeat (setq i (sslength ss))
 (setq blocs (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) blocs))
      )
      (vlax-invoke *acdoc* 'CopyObjects blocs (vla-get-ModelSpace axdbdoc))
      (vla-SaveAs axdbdoc filename)
      (vlax-release-object axdbdoc)
    )
    (progn
      (alert "Impossible d'accéder au fichier cible")
      (vl-catch-all-apply 'vlax-release-object (list axdbdoc))
    )
 )
 (princ)
)

Jbrosteaux · le 19 novembre 2020

Salut,

Essaye ça.

Tu charges le LISP dans le dessin source, tu lances la commande COPYTODWG, tu choisis le dessin cible (il doit être fermé) et c'est tout.

Remplace "XXX,YYY" par les noms de blocs à sélectionner (séparés par une virgule).

(vl-load-com)
(or *acad* (setq *acad* (vlax-get-acad-object)))
(or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))

(defun c:copyToDwg (/ progId majVer ss filename axdbdoc i blocs)
 (if
   (and
     (setq ss (ssget "_X" '((0 . "INSERT") (410 . "Model") (2 . "XXX,YYY")))) ; <- remplacer "XXX,YYY" par les noms de blocs
     (setq filename (getfiled "Fichier cible" "" "dwg" 0))
     (setq progId (if (< (setq majVer (substr (getvar 'acadver) 1 2)) "16")
         "ObjectDBX.AxDbDocument"
         (strcat "ObjectDBX.AxDbDocument." majVer)
       )
     )
     (setq axdbdoc (vla-GetInterfaceObject *acad* progId))
     (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list axdbdoc filename))))
   )
	(progn
  	(repeat (setq i (sslength ss))
    (setq blocs (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) blocs))
  	)
  	(vlax-invoke *acdoc* 'CopyObjects blocs (vla-get-ModelSpace axdbdoc))
  	(vla-SaveAs axdbdoc filename)
  	(vlax-release-object axdbdoc)
	)
	(progn
  	(alert "Impossible d'accéder au fichier cible")
  	(vl-catch-all-apply 'vlax-release-object (list axdbdoc))
	)
 )
 (princ)
)

Bonjour Gile,

Merci pour ton code!

Ca fonctionne très bien.

Est ce qu'il y aurait une possibilité de faire le code de manière a ce qu'il copie les blocs mais c'est moi qui vais manuellement le recoller ensuite sur l'autre fichier ?

Bonne journée,

(gile) · le 19 novembre 2020

Est ce qu'il y aurait une possibilité de faire le code de manière a ce qu'il copie les blocs mais c'est moi qui vais manuellement le recoller ensuite sur l'autre fichier ?

Si tu dois coller les blocs un par un dans le nouveau fichier, je ne vois pas l'intérêt d'une automatisation. Autant utiliser le Design Center.

Jbrosteaux · le 19 novembre 2020

Si tu dois coller les blocs un par un dans le nouveau fichier, je ne vois pas l'intérêt d'une automatisation. Autant utiliser le Design Center.

Le but est de coller plusieurs blocs différents sur un autre plan.

l'automatisation de dire le fichier de destination est top.

Mais si je veux l'utiliser pour un autre travail ca m'ennuie un peu de devoir donner le fichier de destination.

Je pourrais très bien dire que la sélection sera bêtement supprimée, ou déplacée vers un autre calque... enfin tu vois.

Mais tout cela manuellement.

Le point positif c'est que dans le script je n'ai qu'a rajouter le nom des blocs!

Olivier Eckmann · le 19 novembre 2020

Bonjour,

Sinon en utilisant les routines de Gilles, on peut faire peut-être quelque chose comme cela


;; LST2STR
;; Concatène une liste et un séparateur en une chaine
;;
;; Arguments
;; lst : la liste à transformer en chaine
;; sep : le séparateur
;;
;; Exemples
;; (lst2str '(1 2 3) ",") -> "1,2,3"
;; (lst2str '("a" "b" "c") " ") -> "a b c"

(defun lst2str (lst sep)
 (if (cadr lst)
   (strcat (vl-princ-to-string (car lst))
   	sep
   	(lst2str (cdr lst) sep)
   )
   (vl-princ-to-string (car lst))
 )
)

;;============================================================================;;

;; 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 (layoutlist) (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
)

(defun C:SELBLK ( / cnt tmpEnt lsBlk sBlName)
 (setq cnt T)
 (while (setq tmpEnt (tblnext "block" cnt))
   (setq lsBlk (append lsBlk (list (cdr (assoc 2 tmpEnt)))))
   (setq cnt nil)
 )
 (setq sBlName (lst2str (listbox "Bloc" "Choisir le(s) bloc(s)" (mapcar 'cons lsBlk lsBlk) 2) ","))
 (sssetfirst nil (ssget "_X" (list (cons 2 sBlName) (cons 410 (getvar "CTAB")))))
)

Olivier

Jbrosteaux · le 19 novembre 2020

Bonjour,

Sinon en utilisant les routines de Gilles, on peut faire peut-être quelque chose comme cela


;; LST2STR
;; Concatène une liste et un séparateur en une chaine
;;
;; Arguments
;; lst : la liste à transformer en chaine
;; sep : le séparateur
;;
;; Exemples
;; (lst2str '(1 2 3) ",") -> "1,2,3"
;; (lst2str '("a" "b" "c") " ") -> "a b c"

(defun lst2str (lst sep)
 (if (cadr lst)
   (strcat (vl-princ-to-string (car lst))
   	sep
   	(lst2str (cdr lst) sep)
   )
   (vl-princ-to-string (car lst))
 )
)

;;============================================================================;;

;; 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 (layoutlist) (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
)

(defun C:SELBLK ( / cnt tmpEnt lsBlk sBlName)
 (setq cnt T)
 (while (setq tmpEnt (tblnext "block" cnt))
   (setq lsBlk (append lsBlk (list (cdr (assoc 2 tmpEnt)))))
   (setq cnt nil)
 )
 (setq sBlName (lst2str (listbox "Bloc" "Choisir le(s) bloc(s)" (mapcar 'cons lsBlk lsBlk) 2) ","))
 (sssetfirst nil (ssget "_X" (list (cons 2 sBlName) (cons 410 (getvar "CTAB")))))
)

Olivier

Bonjour olivier,

N'étant pas un intelligent de la programmation, peux tu me dire ce à quoi ca correspond?

et comment l'utiliser?

Parceque là, je suis perdu...

Désolé

Curlygoth · le 19 novembre 2020

as tu reçu mon code en mp ?

pour un lisp c'est facile tu le copie colle dans un txt tu le renomme en lsp

ensuite tu glisse dans le dessin et hop il est chargé !

(c'est un des avantages du lisp il est natif d'autocad)

sinon tu peux taper APPload et le chercher et ensuite cliquer sur charger

Olivier Eckmann · le 19 novembre 2020

Bonjour olivier,

N'étant pas un intelligent de la programmation, peux tu me dire ce à quoi ca correspond?
et comment l'utiliser?
Parceque là, je suis perdu...

Désolé

Etant donné que tu t'en es sorti avec le lisp de Gilles, je pensais que tu savais prendre du code et le charger.

Tu ouvres le bloc note,

Tu copies/colles le contenu du code dans le blocnote,

Tu enregistres le fichier avec l'extension .LSP au lieu de de .TXT

Tu le charges dans AutoCAD par glisser/déposer depuis l'explorateur dans l'espace objet

Tu tapes SELBLK à la ligne de commande.

Olivier

Jbrosteaux · le 19 novembre 2020

Etant donné que tu t'en es sorti avec le lisp de Gilles, je pensais que tu savais prendre du code et le charger.

Tu ouvres le bloc note,

Tu copies/colles le contenu du code dans le blocnote,
Tu enregistres le fichier avec l'extension .LSP au lieu de de .TXT
Tu le charges dans AutoCAD par glisser/déposer depuis l'explorateur dans l'espace objet
Tu tapes SELBLK à la ligne de commande.

Olivier

Merci Olivier,

J'ai fais exactement comme tu ma dis, copier l’entièreté de ton code ainsi que les autres étapes mais quand je l'essaye et que je sélectionne dans la liste déroulante le bloc, une fois validé j'ai le message suivant:

SELBLK ; erreur: no function definition: STR2LST

Que faut il faire?

Est ce qu'il y a moyen que la boite de dialogue soit plus grande? car j'ai des noms de blocs qui sont parfois très long...

Olivier Eckmann · le 19 novembre 2020

Bonjour,

Comme toutes les fonctions de Gilles sont chargées sur mon PC, il trouvait aussi celle là.

Je te la remet (à ajouter en début de lisp)

;; 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)
 )
)

Olivier

Jbrosteaux · le 19 novembre 2020

Bonjour,

Comme toutes les fonctions de Gilles sont chargées sur mon PC, il trouvait aussi celle là.

Je te la remet (à ajouter en début de lisp)

;; 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)
 )
)

Olivier

super !

Ca fonctionne

Aurais tu une idée pour la taille de la boite de dialogue?

Car je vois pas toujours les noms complet des blocs...

Merci

(gile) · le 19 novembre 2020

En une seule routine plus concise.

Pour la largeur de la boite de dialogue, à la ligne : width = 80; tu remplaces 80 par la valeur que tu veux.

(defun c:selblocks (/ lst2str lst tmp file dcl_id choice ss)
 (defun lst2str (lst sep)
   (apply 'strcat
   (cons (car lst)
	 (mapcar (function (lambda (x) (strcat sep x))) (cdr lst))
   )
   )
 )
 (while (setq bloc (tblnext "BLOCK" (not bloc)))
   (setq lst (cons (cdr (assoc 2 bloc)) lst))
 )
 (setq	lst  (acad_strlsort
       (vl-remove-if
	 (function (lambda (n) (= (substr n 1 1) "*")))
	 lst
       )
     )
tmp  (vl-filename-mktemp "Tmp.dcl")
file (open tmp "w")
 )
 (write-line
   "getblocks :dialog{
     label = \"Choisir les blocs\";
     width = 80; 
     :boxed_column{"
   file
 )
 (mapcar
   (function
     (lambda (x)
(write-line
  (strcat ":toggle{ key = \"" x "\";label = \"" x "\"; }")
  file
)
     )
   )
   lst
 ) 
   (write-line
     "spacer;
     :button{
       label = \"Tout sélectionner\";
       key = \"all\";
       fixed_width = true;
       alignment = centered; }}
     spacer;
     ok_cancel; }"
     file)
 (close file)
 (setq dcl_id (load_dialog tmp))
 (if (not (new_dialog "getblocks" dcl_id))
   (exit)
 )
 (start_list "lst")
 (mapcar 'add_list lst)
 (end_list)
 (action_tile
"all"
"(foreach x lst
       (set_tile x \"1\"))"
     )
     (action_tile
"accept"
"(foreach x lst
       (if (= \"1\" (get_tile x))
       (setq choice (cons x choice))))
       (done_dialog)"
     )
 (start_dialog)
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 (if choice
   (sssetfirst
     nil
     (ssget "_X"
     (list (cons 0 "INSERT") (cons 410 (getvar 'ctab)) (cons 2 (lst2str choice ",")))
     )
   )
   (sssetfirst nil nil)
 )
 (princ)
)

lecrabe · le 19 novembre 2020

Hello Gilles

1) Merci pour ta routine simple et efficace !

2) Ci-apres une autre routine "SelBlocks" de selection des blocs ...

3) Selection en donnant simplement le debut du nom du Bloc par exemple : PRISE*

4) Et si tu dis * alors tu selectionnes TOUS les Blocs !

LA SANTE, Bye, lecrabe


;; 
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/select-blocks-by-wildcard/td-p/5923154
;;
;; Routine: SelBlocks by BeekeeCZ
;;
;; Select Block by the beginning of the Name ...
;; 

(vl-load-com)

(defun c:SelBlocks ( / bn ss i sn)
 (if (and (setq bn (getstring "Block Names to Select (For example: BL* -- Case Sensitive !) : "))
   (setq ss (ssget "_X" (list '(0 . "INSERT")
			      (cons 2 (strcat "`*U*," bn))))))
   (repeat (setq i (sslength ss))
     (if (not (wcmatch (vla-get-effectivename (vlax-ename->vla-object (setq sn (ssname ss (setq i (1- i)))))) bn))
(ssdel sn ss))))
 (if ss (sssetfirst nil ss))
 (princ)
)

Jbrosteaux · le 19 novembre 2020

En une seule routine plus concise.

Pour la largeur de la boite de dialogue, à la ligne : width = 80; tu remplaces 80 par la valeur que tu veux.

(defun c:selblocks (/ lst2str lst tmp file dcl_id choice ss)
 (defun lst2str (lst sep)
   (apply 'strcat
      (cons (car lst)
     (mapcar (function (lambda (x) (strcat sep x))) (cdr lst))
      )
   )
 )
 (while (setq bloc (tblnext "BLOCK" (not bloc)))
   (setq lst (cons (cdr (assoc 2 bloc)) lst))
 )
 (setq	lst  (acad_strlsort
          (vl-remove-if
     (function (lambda (n) (= (substr n 1 1) "*")))
     lst
          )
        )
tmp  (vl-filename-mktemp "Tmp.dcl")
file (open tmp "w")
 )
 (write-line
   "getblocks :dialog{
     label = \"Choisir les blocs\";
     width = 80; 
     :boxed_column{"
   file
 )
 (mapcar
   (function
     (lambda (x)
(write-line
 	(strcat ":toggle{ key = \"" x "\";label = \"" x "\"; }")
 	file
)
     )
   )
   lst
 ) 
   (write-line
     "spacer;
     :button{
       label = \"Tout sélectionner\";
       key = \"all\";
       fixed_width = true;
       alignment = centered; }}
     spacer;
     ok_cancel; }"
     file)
 (close file)
 (setq dcl_id (load_dialog tmp))
 (if (not (new_dialog "getblocks" dcl_id))
   (exit)
 )
 (start_list "lst")
 (mapcar 'add_list lst)
 (end_list)
 (action_tile
"all"
"(foreach x lst
       (set_tile x \"1\"))"
     )
     (action_tile
"accept"
"(foreach x lst
       (if (= \"1\" (get_tile x))
       (setq choice (cons x choice))))
       (done_dialog)"
     )
 (start_dialog)
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 (if choice
   (sssetfirst
     nil
     (ssget "_X"
        (list (cons 0 "INSERT") (cons 410 (getvar 'ctab)) (cons 2 (lst2str choice ",")))
     )
   )
   (sssetfirst nil nil)
 )
 (princ)
)

Merci Gile,

J'ai essayé mais par contre même en laissant 80, il indique

"La boite de dialogue est grande pour tenir sur l'écran"

J'ai changé le nombre et recharger le lisp mais rien ne fait....

(gile) · le 19 novembre 2020

C'est qu'il y a trop de blocs dans le dessin pour les afficher tous dans la boite de dialogue (il n'y a pas de barres de défilement en DCL).

Sinon, en ligne de commande la routine donnée par lecrabe est très bien si tu veux utiliser des caractères génériques pour les noms de blocs (on peut en mettre plusieurs séparés par des virgules).

(gile) · le 19 novembre 2020

Nouvelle version avec une list_box (on a les barres de défilement mais plus les cases à cocher) et qui prend en compte les blocs dynamiques (anonymes).

Modifier la largeur de la boite de dialogue : width = 80;

Modifier la hauteur de la boite de dialogue : height = 20;

(defun c:selblocks (/ str2lst lst2str lst tmp file dcl_id choice pattern ss i)

 (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)
   )
 )

 (defun lst2str (lst sep)
   (apply 'strcat
   (cons (car lst)
	 (mapcar (function (lambda (x) (strcat sep x))) (cdr lst))
   )
   )
 )
 (while (setq bloc (tblnext "BLOCK" (not bloc)))
   (setq lst (cons (cdr (assoc 2 bloc)) lst))
 )
 (setq	lst  (acad_strlsort
       (vl-remove-if
	 (function (lambda (n) (= (substr n 1 1) "*")))
	 lst
       )
     )
tmp  (vl-filename-mktemp "Tmp.dcl")
file (open tmp "w")
 )
 (write-line
   "getblocks:dialog {
     label=\"Choisir les blocs\";
     width = 80;
     spacer;
     :list_box{
     	height = 20;
       key = \"lst\";
       multiple_select = true; }
     spacer;
     ok_cancel; }"
   file
 )
 (close file)
 (setq dcl_id (load_dialog tmp))
 (if (not (new_dialog "getblocks" dcl_id))
   (exit)
 )
 (start_list "lst")
 (mapcar 'add_list lst)
 (end_list)
 (action_tile
   "accept"
   "(if (/= (get_tile \"lst\") \"\")
      (progn
        (foreach n (str2lst (get_tile \"lst\") \" \")
          (setq choice (cons (nth (atoi n) lst) choice))
        )
      )
    )
    (done_dialog)"
 )
 (start_dialog)
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 (if
   (and
     choice
     (setq pattern (lst2str choice ","))
     (setq ss (ssget "_X"
	      (list
		(cons 0 "INSERT")
		(cons 410 (getvar 'ctab))
		(cons 2 (strcat "`*U*," pattern))
	      )
       )
     )
   )
    (progn
      (repeat (setq i (sslength ss))
 (if
   (not
     (wcmatch
       (getpropertyvalue
	 (getpropertyvalue
	   (setq block (ssname ss (setq i (1- i))))
	   "BlockTableRecord"
	 )
	 "Name"
       )
       pattern
     )
   )
    (ssdel block ss)
 )
      )
      (sssetfirst nil ss)
    )
    (sssetfirst nil nil)
 )
 (princ)
)

Jbrosteaux · le 20 novembre 2020

Super!

C'est ce que j'imaginais comme truc.

Où peut on apprendre ce langage de programmation?

Ca facilite grandement le travail à faire

LElemurien · le 20 novembre 2020

Bonjour,

c'est possible si on a du temps et de la volonté pour apprendre

Pour débuter et plus il y a les très bons sites de Gilles le lien et Didier le lien

Il y a d'autre infos aussi à trouver sur ce site dans la section Débuter en LISP

Il faut du temps mais quand on commence à comprendre cela devient vraiment très intéressant .

Bonne journée

Curlygoth · le 20 novembre 2020

le lisp est le language natif d'autocad

(j'espere ne pas me trompé si je ça : )

je me suis orienté plus sur du vb qui te permettra d'interagir avec des logicieils tiers ;-)

macro pour sélectionner plusieurs blocs

Messages recommandés

Meilleurs contributeurs dans ce sujet

Jours populaires

Meilleurs contributeurs dans ce sujet

Jours populaires

Messages populaires

lecrabe

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Information importante