Aller au contenu

Selection par bloc (dyn)


Fruity

Messages recommandés

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

Lien vers le commentaire
Partager sur d’autres sites

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

Autodesk Expert Elite Team

Lien vers le commentaire
Partager sur d’autres sites

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

Lien vers le commentaire
Partager sur d’autres sites

Invité
Répondre à ce sujet…

×   Collé en tant que texte enrichi.   Coller en tant que texte brut à la place

  Seulement 75 émoticônes maximum sont autorisées.

×   Votre lien a été automatiquement intégré.   Afficher plutôt comme un lien

×   Votre contenu précédent a été rétabli.   Vider l’éditeur

×   Vous ne pouvez pas directement coller des images. Envoyez-les depuis votre ordinateur ou insérez-les depuis une URL.

×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité