Jump to content

macro pour sélectionner plusieurs blocs


Recommended Posts

  • Replies 50
  • Created
  • Last Reply

Top Posters In This Topic

Top Posters In This Topic

Popular Posts

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 ex

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é

Link to post
Share on other sites

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

Link to post
Share on other sites

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

 

blink.gif

Link to post
Share on other sites

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.

 

 

Link to post
Share on other sites

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

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Link to post
Share on other sites

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,

Link to post
Share on other sites

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.

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Link to post
Share on other sites

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!

Link to post
Share on other sites

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

Link to post
Share on other sites

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é

Link to post
Share on other sites

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

Link to post
Share on other sites

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

Link to post
Share on other sites

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...

 

 

 

Link to post
Share on other sites

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

Link to post
Share on other sites

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

Link to post
Share on other sites

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

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Link to post
Share on other sites

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

  • Upvote 1

Autodesk Expert Elite Team

Link to post
Share on other sites

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....

Link to post
Share on other sites

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

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Link to post
Share on other sites

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

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Link to post
Share on other sites

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 wink.gif.

 

Bonne journée

Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...

×
×
  • Create New...