CadXP: macro pour sélectionner plusieurs blocs - CadXP

Aller au contenu

  • 3 Pages +
  • 1
  • 2
  • 3
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

macro pour sélectionner plusieurs blocs

#41 L'utilisateur est hors-ligne   Olivier Eckmann 

  • ceinture noire 2em dan
  • Groupe : Membres
  • Messages : 1 471
  • Inscrit(e) : 29-décembre 11
  • LocationLongjumeau (91)

Posté 19 novembre 2020 - 12:27

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
0

#42 L'utilisateur est hors-ligne   Jbrosteaux 

  • ceinture noire
  • Groupe : Membres
  • Messages : 303
  • Inscrit(e) : 17-septembre 09

Posté 19 novembre 2020 - 12:32

Voir le messageOlivier Eckmann, le 19 novembre 2020 - 12:27 , dit :

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
0

#43 L'utilisateur est hors-ligne   (gile) 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 11 439
  • Inscrit(e) : 02-septembre 05

Posté 19 novembre 2020 - 14:32

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
Image IPB
0

#44 L'utilisateur est en ligne   lecrabe 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 9 213
  • Inscrit(e) : 10-décembre 03
  • LocationLoire (42)

Posté 19 novembre 2020 - 14:59

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

Autodesk Expert Elite Team
1

#45 L'utilisateur est hors-ligne   Jbrosteaux 

  • ceinture noire
  • Groupe : Membres
  • Messages : 303
  • Inscrit(e) : 17-septembre 09

Posté 19 novembre 2020 - 15:09

Voir le message(gile), le 19 novembre 2020 - 14:32 , dit :

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

#46 L'utilisateur est hors-ligne   (gile) 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 11 439
  • Inscrit(e) : 02-septembre 05

Posté 19 novembre 2020 - 15:29

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
Image IPB
0

#47 L'utilisateur est hors-ligne   (gile) 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 11 439
  • Inscrit(e) : 02-septembre 05

Posté 19 novembre 2020 - 16:09

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
Image IPB
0

#48 L'utilisateur est hors-ligne   Jbrosteaux 

  • ceinture noire
  • Groupe : Membres
  • Messages : 303
  • Inscrit(e) : 17-septembre 09

Posté 20 novembre 2020 - 09:33

Super!
C'est ce que j'imaginais comme truc.
Où peut on apprendre ce langage de programmation?
Ca facilite grandement le travail à faire Image IPB
0

#49 L'utilisateur est hors-ligne   LElemurien 

  • ceinture bleue
  • Groupe : Membres
  • Messages : 165
  • Inscrit(e) : 01-novembre 18

Posté 20 novembre 2020 - 10:30

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

Bonne journée
0

#50 L'utilisateur est hors-ligne   Curlygoth 

  • ceinture verte
  • Groupe : Membres
  • Messages : 90
  • Inscrit(e) : 09-mai 19
  • LocationJuste devant toi

Posté 20 novembre 2020 - 10:33

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 ;-)
Je dessine sur Autocad depuis mes 16 ans, je fais tout avec 2D/3D etc...
Et maintennant ? Ben, je ne dessine quasiment plus...
Je programme pour que mon ordinateur travail à ma place
Et je créé des outils pour gérer planning, mail auto, rapport issu du dessin et j'en passe.
(Uniquement en VBA et VB.net / Sql)

Mon site Web (en cours de construction) : Site
0

#51 L'utilisateur est hors-ligne   CTZen 

  • ceinture noire
  • Groupe : Membres
  • Messages : 331
  • Inscrit(e) : 08-août 13
  • LocationChampigny Sur Marne

Posté 20 novembre 2020 - 10:48

Le LISP j'ai toujours trouvé ça particulier n'empêche ...

Autant j'ai facilement appris le HTML, le CSS, le VBA (Merci Curly pour la formation :) ) sans de difficulté particulière de compréhension ...
Autant avec le LISP j'ai essayé plusieurs fois ... j'ai jamais réussi ! Image IPBImage IPBImage IPBImage IPB
AutoCAD Map 3D 2021 (24.0.30.17) base R.118.0.0 - 2021.1
Covadis 17.1b + AutoPiste
Mensura Genius 9.1.0
Windows 10 Famille v.20H2 - 64 bits


Toujours à l'affût des bonnes astuces !
0

Partager ce sujet :


  • 3 Pages +
  • 1
  • 2
  • 3
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

1 utilisateur(s) en train de lire ce sujet
0 membre(s), 1 invité(s), 0 utilisateur(s) anonyme(s)