Selection par bloc (dyn)

[Fruity]

Bonjour a tous

Voila ma question:

j'utilise très souvent ce lisp pour sélectionner tous les blocs portant le même nom en un clic:

 

(defun c:sel(/ blo sel)
(sssetfirst nil)
(setq blo(car(entsel)))
(if(=(cdr(assoc 0(entget blo)))"INSERT")
(sssetfirst (setq sel(ssget "X"(list(cons 0 "INSERT") (assoc 2(entget blo))))) sel)))

 

Le souci que j'ai ces derniers tps, c'est que je crée beaucoup de blocs dynamiques, et ca ne fonctionne plus avec ce type d'objet.

Quelqu'un saurait me l'adapter svp?

 

Merci

[lecrabe]

Hello

 

Voici une excellente routine de selection des blocs classiques et dynamiques !

Avec en plus le support des caracteres magiques comme : *

C Tip-Top pour selectionner par exemple un ensemble de blocs commencant par le meme prefixe ...

 

Tire de mon stock de qq milliers de routines ... MERCI Mr BeekeeCZ ...

 

LA SANTE (Stay Safe), Bye, lecrabe "triste"

Automne 2020, la retraite

 

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

;; 
;; --- Interrogation Entite/Objet en Lisp ---
;; (entget (car (entsel)) '("*"))
;; 

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

[Fruity]

Merci pour la réponse rapide.

 

Alors le lisp fonctionne mais le problème c'est qu'il faut connaitre et taper le nom du bloc souhaité.

Quand yen a des dizaines, ca devient vite compliqué...

Il faudrait faire un mix des 2 lisp pour utiliser le clic pour la selection, mais perso, je ne maitrise pas.

 

edit:

j'ai trouvé ceci, qui est un mix de tout et qui fait bien l'affaire, en ajoutant un filtre par calque:

 

(defun c:GetBlocks (/ *error* D f id run go sel layers blocks s lst ss i sn bn go BlockTable LayerTable)
 ;;	Author: Tharwat Al Shoufi	;;
 ;;	GetBlocks Program 		;;
 ;;	Date : 04. August. 2014		;;
 (defun *error* (msg)
   (if (and D (setq D (findfile D)))
     (vl-file-delete D)
   )
   (if (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")
     (princ msg)
     (princ (strcat "\n ** Error : " msg " **"))
   )
 )
 ;;							;;
 (defun BlockTable (/ i a l nm)
   (while (setq i (tblnext "BLOCK" (not i)))
     (if (not (wcmatch (setq nm (cdr (assoc 2 i))) "`**"))
       (setq l (cons nm l))
     )
   )
   (setq l (acad_strlsort l))
 )
 ;;							;;
 (defun LayerTable (/ i a nm l)
   (while (setq i (tblnext "LAYER" (not i)))
     (if (not (wcmatch (setq nm (cdr (assoc 2 i))) "*|*"))
       (setq l (cons (cdr (assoc 2 i)) l))
     )
   )
   (setq l (acad_strlsort l))
 )
 ;;							;;
 (if (ssget "_X" '((0 . "INSERT")))
   (setq run t)
   (alert "No blocks found in this drawing !!")
 )
 (if (and run (setq D (vl-filename-mktemp nil nil ".dcl")) (setq f (open D "w")))
   (progn (write-line
            (strcat
              "test : dialog { label = \"Highlight Blocks\"; width = 36;" "spacer;"
              ": boxed_column { label = \"Options\";" ": button { label = \"Select >>\"; key = \"sbk\";}" "spacer;"
              ": popup_list { label = \"Block:\"; key = \"bl\"; width = 32;}" "spacer;"
              ": popup_list { label = \"Layer:\"; key = \"lay\"; width = 32;}}" "spacer;"
              ": boxed_radio_column { label = \"Selection Way:\";"
              ": radio_button { label = \"Global\"; key = \"g\"; value = \"1\";}"
              ": radio_button { label = \"Window\";key = \"w\";}}" "spacer;"
              ": boxed_row { label = \"Action\"; fixed_width = true; alignment = centered;"
              ": button { label = \"Okay\"; key = \"oki\"; is_default = true; height = 1.75; width = 12;}"
              ": button { label = \"Exit\"; key = \"esc\"; is_cancel = true; height = 1.75; width = 12;}}}"
             )
            f
          )
          (close f)
   )
 )
 (if (or (not D) (not (new_dialog "test" (setq id (load_dialog D)))))
   (progn (if (> id 0)
            (unload_dialog id)
          )
          (if (and D (setq D (findfile D)))
            (vl-file-delete D)
          )
   )
   (progn
     (setq layers (append (list "-- On Any Layer --") (LayerTable))
           blocks (BlockTable)
     )
     (mapcar '(lambda (k l) (start_list k) (mapcar 'add_list l) (end_list))
             (list "bl" "lay")
             (list blocks layers)
     )
     (if (and *GetBlockName* (tblsearch "BLOCK" *GetBlockName*))
       (set_tile "bl" (itoa (vl-position *GetBlockName* blocks)))
     )
     (action_tile "sbk" "(setq sel t)(done_dialog)")
     (action_tile
       "oki"
       "(setq lst (mapcar 'get_tile (list \"bl\" \"lay\" \"g\" \"w\"))
                                    bn (nth (atoi (car lst)) blocks)
                                    go t *GetBlockName* nil) (done_dialog)"
     )
     (action_tile "esc" "(setq go nil) (done_dialog)")
     (start_dialog)
     (unload_dialog id)
     (vl-file-delete D)
   )
 )
 (if (and sel (princ "\n Pick Block :") (setq s (ssget "_+.:S:E" '((0 . "INSERT")))))
   (progn (setq *GetBlockName* (vla-get-effectivename (vlax-ename->vla-object (ssname s 0))))
          (c:GetBlocks)
   )
 )
 (if (and bn
          go
          (setq ss (ssget (if (eq (caddr lst) "1")
                            "_X"
                            "_:L"
                          )
                          (list '(0 . "INSERT")
                                (cons 8
                                      (if (eq (cadr lst) "0")
                                        "*"
                                        (nth (atoi (cadr lst)) layers)
                                      )
                                )
                                (cons 2 (strcat "`*U*," bn))
                          )
                   )
          )
     )
   (progn (repeat (setq i (sslength ss))
            (if (not (eq (vla-get-effectivename (vlax-ename->vla-object (setq sn (ssname ss (setq i (1- i)))))) bn))
              (ssdel sn ss)
            )
          )
          (sssetfirst nil ss)
   )
 )
 (princ)
)