Select all instances of a block, including dynamic

Hi, People...

Here is the prob... I use constantly a lisp routine to select all instances of a picked block, but now I realize it doesn't work with dynamic blocks, because each new copy or insertion of them get a new annonymous name.

i know is possible to add the effective block name from a dynamic block.. but I don't know how to modify the routine to make it work for both normal and dynamic... here are both codes... The first is the one for normal blocks.. and the other is a bunch of lines I found in augi related to get the effective block name using vla.

(defun c:SB2 ()
(COND (T (SETVAR "CMDECHO" 0)
(SETQ L1 nil)
(WHILE (= L1 nil)
  (SETQ L1(ENTSEL "Pick BLOCK to acquire its instances in the drawing...")))
  (SETQ L1 (ENTGET (CAR L1)) L1 (CDR (ASSOC 2 L1))L1 (SSGET "X" (LIST (CONS 2 L1)))) 
(PRINC)
  )
 )
)

(setq Sel (entsel "\n Select block to select likewise: "))
(setq Obj (vlax-ename->vla-object (car Sel)))
(= (vla-get-ObjectName Obj) "AcDbBlockReference")
(= (vla-get-IsDynamicBlock obj) :vlax-true)
(setq BlkName (vla-get-EffectiveName Obj)); end and

can anybody make this sb.lsp to work with either dynamic and normal blocks?

This should do what you want:

(defun c:getblk    (/ e name n out ss x rjp-getblockname)
 (defun rjp-getblockname (obj)
   (if    (vlax-property-available-p obj 'effectivename)
     (vla-get-effectivename obj)
     (vla-get-name obj)
   )
 )
 (if (setq x     (ssget '((0 . "INSERT")))
       x     (ssname x 0)
       name (rjp-getblockname (vlax-ename->vla-object x))
       ss     (ssget "_X" '((0 . "INSERT")))
       n     -1
       out     (ssadd)
     )
   (while (setq e (ssname ss (setq n (1+ n))))
     (if (= (rjp-getblockname (vlax-ename->vla-object e)) name)
   (ssadd e out)
     )
   )
 )
 (sssetfirst nil out)
 (princ)
)

This should do what you want:

 

(defun c:getblk    (/ e match n name ss x rjp-getblockname)
 (defun rjp-getblockname (obj)
   (if    (vlax-property-available-p obj 'effectivename)
     (vla-get-effectivename obj)
     (vla-get-name obj)
   )
 )
 (if (setq x      (ssget '((0 . "INSERT")))
       x      (ssname x 0)
       match (rjp-getblockname (vlax-ename->vla-object x))
       ss      (ssget "_X" '((0 . "INSERT")))
       n      -1
     )
   (while (setq e (ssname ss (setq n (1+ n))))
     (setq name (rjp-getblockname (vlax-ename->vla-object e)))
     (if (/= name match)
   (ssdel e ss)
     )
   )
 )
 (sssetfirst nil ss)
 (princ)
)

mmm.. not really... actually it kinda selects all blocks in the drawing... I guess I needed to be more specific...

The routine that I use allows me to pick a block... then it puts in the autocad selection memory all the instances of that selected block in the current drawing... Then I can use any another routine to apply to all of them by selecting them using the "previous" option when selecting objects...

it's quite useful.. but doesn´t work with dynamic blocks..

This one you posted... selects all the blocks (normal and dinamic) and Now I think it can be useful .. but what I wanted is a similar lisp to get all the instances of only one selected block, normal or dynamic. And It would be better to get them using the "previous" option instead of grips, 'cause some lisp routine I use don´t accept grips, just normal selection after some prompts.

Hi,

Here's a routine to select dynamic blocks according to their dynamic properties values.

;;; SSD R2.3 (gile) 14/07/2008
;;; Select dynamic blocks according to dynamic properties values
;;; Using:
;;; To make a selection, enter ssd at command prompt or,
;;; within a modification command, type (ssd) at "Select objects: " prompt
;;; Select a source dynamic block
;;; Choose properties values to filter in the dialog box (an empty tile means "all vaue")
(defun ssd (/ DynBlkPropValue ss blk name pop ret fuzz sel res)
 (vl-load-com)
 ;; DynBlkPropValue
 ;; Dialog box to choose dynamic properties values
 ;;
 ;; Argument : the dynamic properties list (vla-object list)
 (defun DynBlkPropValue (lst / tmp file pn av dcl_id val)
   (setq tmp  (vl-filename-mktemp "Tmp.dcl")
  file (open tmp "w")
   )
   (write-line
     (strcat
"DynBlkProps:dialog{label=\"Dynamic block filter\";"
":text{label=\"Block name: \""
(vl-prin1-to-string name)
";}spacer;:boxed_column{label=\"Dynamic properties\";"
     )
     file
   )
   (foreach p lst
     (setq pn (vla-get-PropertyName p))
     (cond
((setq av (vlax-get p 'AllowedValues))
 (setq pop
	(cons (cons pn (cons "" (mapcar 'vl-princ-to-string av)))
	      pop
	)
 )
 (write-line
   (strcat
     ":popup_list{label="
     (vl-prin1-to-string pn)
     ";key="
     (vl-prin1-to-string pn)
     ";edit_width=25;allow_accept=true;}"
   )
   file
 )
)
((/= pn "Origin")
 (setq fuzz (cons pn fuzz))
 (write-line
   (strcat
     ":row{:edit_box{label="
     (vl-prin1-to-string pn)
     ";key="
     (vl-prin1-to-string pn)
     ";edit_width=12;allow_accept=true;}"
     ":edit_box{label=\"Fuzz\";key="
     (vl-prin1-to-string (strcat pn "_fuzz"))
     ";value=\"0.0\";edit_width=6;allow_accept=true;}}"
   )
   file
 )
)
     )
   )
   (write-line
     (strcat
"}spacer;:radio_row{key=\"selset\";"
":radio_button{label=\"All drawing\";key=\"all\";value=\"1\";}"
":radio_button{label=\"Selection\";key=\"sel\";}}"
"spacer;ok_cancel;}"
     )
     file
   )
   (close file)
   (setq dcl_id (load_dialog tmp))
   (if	(not (new_dialog "DynBlkProps" dcl_id))
     (exit)
   )
   (foreach p pop
     (start_list (car p))
     (mapcar 'add_list (cdr p))
     (end_list)
   )
   (action_tile
     "accept"
     "(foreach p (mapcar 'vla-get-PropertyName lst)
     (if (assoc p pop)
     (setq val (nth (atoi (get_tile p)) (cdr (assoc p pop))))
     (setq val (get_tile p)))
     (if (and val (/= val \"\"))
     (setq ret (cons (cons p val) ret))))
     (setq fuzz (mapcar (function (lambda (x)
     (cons x (get_tile (strcat x \"_fuzz\"))))) fuzz))
     (and (not ret) (setq ret T))
     (setq sel (get_tile \"selset\"))
     (done_dialog)"
   )
   (action_tile "cancel" "(setq ret nil)")
   (start_dialog)
   (unload_dialog dcl_id)
   (vl-file-delete tmp)
   ret
 )
 ;;----------------------------------------------------;;
 (and
   (or
     (and
(setq ss (cadr (ssgetfirst)))
(= 1 (sslength ss))
(setq blk (vlax-ename->vla-object (ssname ss 0)))
(sssetfirst nil nil)
     )
     (and
(sssetfirst nil nil)
(setq blk (car (entsel)))
(setq blk (vlax-ename->vla-object blk))
     )
   )
   (= (vla-get-ObjectName blk) "AcDbBlockReference")
   (= (vla-get-IsDynamicBlock blk) :vlax-true)
   (setq name (vla-get-EffectiveName blk))
   (DynBlkPropValue
     (vlax-invoke blk 'getDynamicBlockProperties)
   )
   (if	(= sel "all")
     (ssget "_X"
     (list '(0 . "INSERT") (cons 2 (strcat name ",`*U*")))
     )
     (ssget (list '(0 . "INSERT") (cons 2 (strcat name ",`*U*")))
     )
   )
   (setq res (ssadd))
   (vlax-for b	(setq ss (vla-get-ActiveSelectionSet
		   (vla-get-activeDocument
		     (vlax-get-acad-object)
		   )
		 )
	)
     (if
(and
  (= (vla-get-EffectiveName b) name)
  (or
    (= ret T)
    ((lambda (lst)
       (apply
	 '=
	 (cons
	   T
	   (mapcar
	     (function
	       (lambda (p / n v l u f)
		 (setq n (car p)
		       l (assoc n lst)
		       u (vla-get-UnitsType (caddr l))
		 )
		 (equal	(cond
			  ((= 0 u) (cdr p))
			  ((= 1 u) (angtof (cdr p)))
			  (T (distof (cdr p)))
			)
			(cadr l)
			(if (and (setq f (cdr (assoc n fuzz)))
				 (numberp (read f))
			    )
			  (atof f)
			  0.0
			)
		 )
	       )
	     )
	     ret
	   )
	 )
       )
     )
      (mapcar
	(function
	  (lambda (p / n v)
	    (list
	      (setq n (vla-get-PropertyName p))
	      (vlax-get p 'Value)
	      p
	    )
	  )
	)
	(vlax-invoke b 'getDynamicBlockProperties)
      )
    )
  )
)
 (ssadd (vlax-vla-object->ename b) res)
     )
   )
   (vla-delete ss)
 )
 res
)
;;; Calling function
(defun c:ssd ()
 (sssetfirst nil (ssd))
 (princ)
)

That is strange....I updated the code above. Give it a try now.

Hi,

 

Here's a routine to select dynamic blocks according to their dynamic properties values.

 

;;; SSD R2.3 (gile) 14/07/2008
;;; Select dynamic blocks according to dynamic properties values
;;; Using:
;;; To make a selection, enter ssd at command prompt or,
;;; within a modification command, type (ssd) at "Select objects: " prompt
;;; Select a source dynamic block
;;; Choose properties values to filter in the dialog box (an empty tile means "all vaue")
(defun ssd (/ DynBlkPropValue ss blk name pop ret fuzz sel res)
 (vl-load-com)
 ;; DynBlkPropValue
 ;; Dialog box to choose dynamic properties values
 ;;
 ;; Argument : the dynamic properties list (vla-object list)
 (defun DynBlkPropValue (lst / tmp file pn av dcl_id val)
   (setq tmp  (vl-filename-mktemp "Tmp.dcl")
     file (open tmp "w")
   )
   (write-line
     (strcat
   "DynBlkProps:dialog{label=\"Dynamic block filter\";"
   ":text{label=\"Block name: \""
   (vl-prin1-to-string name)
   ";}spacer;:boxed_column{label=\"Dynamic properties\";"
     )
     file
   )
   (foreach p lst
     (setq pn (vla-get-PropertyName p))
     (cond
   ((setq av (vlax-get p 'AllowedValues))
    (setq pop
       (cons (cons pn (cons "" (mapcar 'vl-princ-to-string av)))
             pop
       )
    )
    (write-line
      (strcat
        ":popup_list{label="
        (vl-prin1-to-string pn)
        ";key="
        (vl-prin1-to-string pn)
        ";edit_width=25;allow_accept=true;}"
      )
      file
    )
   )
   ((/= pn "Origin")
    (setq fuzz (cons pn fuzz))
    (write-line
      (strcat
        ":row{:edit_box{label="
        (vl-prin1-to-string pn)
        ";key="
        (vl-prin1-to-string pn)
        ";edit_width=12;allow_accept=true;}"
        ":edit_box{label=\"Fuzz\";key="
        (vl-prin1-to-string (strcat pn "_fuzz"))
        ";value=\"0.0\";edit_width=6;allow_accept=true;}}"
      )
      file
    )
   )
     )
   )
   (write-line
     (strcat
   "}spacer;:radio_row{key=\"selset\";"
   ":radio_button{label=\"All drawing\";key=\"all\";value=\"1\";}"
   ":radio_button{label=\"Selection\";key=\"sel\";}}"
   "spacer;ok_cancel;}"
     )
     file
   )
   (close file)
   (setq dcl_id (load_dialog tmp))
   (if    (not (new_dialog "DynBlkProps" dcl_id))
     (exit)
   )
   (foreach p pop
     (start_list (car p))
     (mapcar 'add_list (cdr p))
     (end_list)
   )
   (action_tile
     "accept"
     "(foreach p (mapcar 'vla-get-PropertyName lst)
     (if (assoc p pop)
     (setq val (nth (atoi (get_tile p)) (cdr (assoc p pop))))
     (setq val (get_tile p)))
     (if (and val (/= val \"\"))
     (setq ret (cons (cons p val) ret))))
     (setq fuzz (mapcar (function (lambda (x)
     (cons x (get_tile (strcat x \"_fuzz\"))))) fuzz))
     (and (not ret) (setq ret T))
     (setq sel (get_tile \"selset\"))
     (done_dialog)"
   )
   (action_tile "cancel" "(setq ret nil)")
   (start_dialog)
   (unload_dialog dcl_id)
   (vl-file-delete tmp)
   ret
 )
 ;;----------------------------------------------------;;
 (and
   (or
     (and
   (setq ss (cadr (ssgetfirst)))
   (= 1 (sslength ss))
   (setq blk (vlax-ename->vla-object (ssname ss 0)))
   (sssetfirst nil nil)
     )
     (and
   (sssetfirst nil nil)
   (setq blk (car (entsel)))
   (setq blk (vlax-ename->vla-object blk))
     )
   )
   (= (vla-get-ObjectName blk) "AcDbBlockReference")
   (= (vla-get-IsDynamicBlock blk) :vlax-true)
   (setq name (vla-get-EffectiveName blk))
   (DynBlkPropValue
     (vlax-invoke blk 'getDynamicBlockProperties)
   )
   (if    (= sel "all")
     (ssget "_X"
        (list '(0 . "INSERT") (cons 2 (strcat name ",`*U*")))
     )
     (ssget (list '(0 . "INSERT") (cons 2 (strcat name ",`*U*")))
     )
   )
   (setq res (ssadd))
   (vlax-for b    (setq ss (vla-get-ActiveSelectionSet
              (vla-get-activeDocument
                (vlax-get-acad-object)
              )
            )
       )
     (if
   (and
     (= (vla-get-EffectiveName b) name)
     (or
       (= ret T)
       ((lambda (lst)
          (apply
        '=
        (cons
          T
          (mapcar
            (function
              (lambda (p / n v l u f)
            (setq n (car p)
                  l (assoc n lst)
                  u (vla-get-UnitsType (caddr l))
            )
            (equal    (cond
                 ((= 0 u) (cdr p))
                 ((= 1 u) (angtof (cdr p)))
                 (T (distof (cdr p)))
               )
               (cadr l)
               (if (and (setq f (cdr (assoc n fuzz)))
                    (numberp (read f))
                   )
                 (atof f)
                 0.0
               )
            )
              )
            )
            ret
          )
        )
          )
        )
         (mapcar
       (function
         (lambda (p / n v)
           (list
             (setq n (vla-get-PropertyName p))
             (vlax-get p 'Value)
             p
           )
         )
       )
       (vlax-invoke b 'getDynamicBlockProperties)
         )
       )
     )
   )
    (ssadd (vlax-vla-object->ename b) res)
     )
   )
   (vla-delete ss)
 )
 res
)
;;; Calling function
(defun c:ssd ()
 (sssetfirst nil (ssd))
 (princ)
)

It's good... we gotta a winner. I guess I can stay with this one.

Again... about the blocks collection I've been working on.. I have been busy pouring some concrete for my small new house... but Now I got all the lisp tools to finish it quickly... I hope is all done in 2 more weeks...

Ok,

It is working now... Actually that is what I wanted.. Gilles' is very good.. even it's got some good options... but I am kind of used to only select a block type for a specific purpose many times a day by just picking it... yours is faster, so I think I will use yours...

Thanks Ron...

It was more difficult than I thought...

That is strange....I updated the code above. Give it a try now.

Wow, great script, a real timesaver!

They should include something like this in qs or filter imo.

Thanks Gile for the ssd.lsp I've been looking for something like that for a while. Now I don't have isolate my blocks to count them.

This should do what you want:

 

(defun c:getblk    (/ e name n out ss x rjp-getblockname)
 (defun rjp-getblockname (obj)
   (if    (vlax-property-available-p obj 'effectivename)
     (vla-get-effectivename obj)
     (vla-get-name obj)
   )
 )
 (if (setq x     (ssget '((0 . "INSERT")))
       x     (ssname x 0)
       name (rjp-getblockname (vlax-ename->vla-object x))
       ss     (ssget "_X" '((0 . "INSERT")))
       n     -1
       out     (ssadd)
     )
   (while (setq e (ssname ss (setq n (1+ n))))
     (if (= (rjp-getblockname (vlax-ename->vla-object e)) name)
   (ssadd e out)
     )
   )
 )
 (sssetfirst nil out)
 (princ)
)

Hey Ron...

I don´t understand... yesterday it was working fine... but now I get this error...

; error: no function definition: VLAX-ENAME->VLA-OBJECT

Do you know what can be happening?

I'm going out on a limb here as my LISP knowledge is miniscule, but I'm guessing that the code you are running today is missing a VL-load command. I'm guessing that one of the routines that you loaded yesterday had it in there and it styed loaded all day. then you shut down and lost it.

Add this (vl-load-com) just after the (defun...) command, RELOAD and try again. If that's not the problem I'm sure a LISP guru will be along shortly.

Glen

I'm going out on a limb here as my LISP knowledge is miniscule, but I'm guessing that the code you are running today is missing a VL-load command. I'm guessing that one of the routines that you loaded yesterday had it in there and it styed loaded all day. then you shut down and lost it.

 

Add this (vl-load-com) just after the (defun...) command, RELOAD and try again. If that's not the problem I'm sure a LISP guru will be along shortly.

 

Glen

You're right... Now it works...

(defun c:sb    (/ e name n out ss x rjp-getblockname)
(vl-load-com)
(prompt "\n   Pick BLOCK to acquire its instances in the drawing...") 
 (defun rjp-getblockname (obj)
   (if    (vlax-property-available-p obj 'effectivename)
     (vla-get-effectivename obj)
     (vla-get-name obj)
   )
 )
 (if (setq x     (ssget '((0 . "INSERT")))
       x     (ssname x 0)
       name (rjp-getblockname (vlax-ename->vla-object x))
       ss     (ssget "_X" '((0 . "INSERT")))
       n     -1
       out     (ssadd)
     )
   (while (setq e (ssname ss (setq n (1+ n))))
     (if (= (rjp-getblockname (vlax-ename->vla-object e)) name)
   (ssadd e out)
     )
   )
 )
 (sssetfirst nil out)
 (princ)
)

And now I remember I had some other routines with the same problem... now I know how to fix it...

thanks!!