Find block by attribute value

[lshivers]

I'd like a lisp routine to find a block by an attribute value within that block and zoom to the block. i know that i can use autocad's find command but i'm looking to use this feature within another routine i'm trying to write.

Larry

[mweaver]

I'd like a lisp routine to find a block by an attribute value within that block and zoom to the block. i know that i can use autocad's find command but i'm looking to use this feature within another routine i'm trying to write.

Larry

This isn't exactly what you want, but it is fairly close. This prompts you to select an attribute and it then selects all insertions of that block with that same attribute value.
(defun GetInsertsByExample (/ ss1 ss2 atts
att ent obj effname
inslist obj1 objatt ss2list
tagent tagstring tagvalue
)
(cond
;;Ensure we selected something
((null (setq ent (entsel "\nSelect example tag: ")))
nil
)
;;Make sure it has attributes
((= :vlax-false
(vla-get-hasattributes
(setq obj1 (vlax-ename->vla-object (car ent)))
)
)
nil
)
;;Make sure we selected it by an attribute
((not
(eq
"AcDbAttribute"
(vla-get-objectname
(setq
TagEnt (nentselp (cadr ent))
objAtt (vlax-ename->vla-object (car TagEnt))
)
)
)
)
(alert
"\nPlease select the block insertion by it's attribute. "
)
nil
)
;;We've got what we need, let's go to work
(T
(setq
ss2 (ssget
"X"
(list
'(0 . "INSERT")
'(66 . 1)
)
)
ss2List (mapcar (function (lambda (ent)
(vlax-ename->vla-object (cadr ent))
)
)
(ssnamex ss2)
)
effname (vla-get-effectivename obj1)
;;remove inserts that aren't our effective name
ss2list (vl-remove-if-not
(function
(lambda (objInsert)
(= effname (vla-get-effectivename objInsert))
)
)
ss2List
)
TagString (vla-get-tagstring objAtt)
TagValue (vla-get-textstring objAtt)
InsList (mapcar (function
(lambda (obj)
(setq
Atts (vla-getattributes obj)
Atts (vlax-variant-value Atts)
Atts (vlax-safearray->list Atts)
;;remove attributes that don't have our tagstring or value
Atts (vl-remove-if-not
(function (lambda (att)
(and
(= TagString
(vla-get-tagstring att)
)
(= TagValue
(vla-get-textstring att)
)
)
)
)
Atts
)
)
(cons obj (list atts))
)
)
ss2list
)
;;remove inserts that don't have our attribute
inslist (vl-remove-if
(function
(lambda (InsertWithAtts)
(null (cadr InsertWithAtts))
)
)
inslist
)
) ;end setq
) ;end T
) ;end cond
)

[David Bethel]

Here's a simple one that I use:

(defun c:find-att (/ ov ss i en ed an ad)
(while (not ov)
(setq ov (getstring t "\nATTRIB Value To Search For: ")))

(and (setq ss (ssget "X" (list (cons 0 "INSERT")
(cons 66 1)
(if (getvar "CTAB")
(cons 410 (getvar "CTAB"))
(cons 67 (- 1 (getvar "TILEMODE")))))))
(setq i (sslength ss))
(while (not (minusp (setq i (1- i))))
(setq en (ssname ss i)
ed (entget en)
an (entnext en)
ad (entget an))
(while (/= "SEQEND" (cdr (assoc 0 ad)))
(if (= (strcase ov)
(strcase (cdr (assoc 1 ad))))
(progn
(command "_.ZOOM" "_C" (cdr (assoc 10 ed)) "")
(getstring "\nPress Enter To Continue Searching...")))
(setq an (entnext an)
ad (entget an)))))
(prin1))

-David