Ok, I found a bug in the code posted above, here is the corrected code:
;Written by: Chris Wade - 11/23/2010
(defun c:dtr ( / ss ent obtyp Doc i j attribs1 attribs2 attribs-list1 attribs-list2 tst tsttyp bname ss2)
(vl-load-com)
(vl-cmdf "._-insert" "BEI DETAIL BOX - R3B")(command);Insert the block, but do not place it on the drawing, so that there is not an error later on.
(setq Doc (vla-get-activedocument (vlax-get-acad-object))); Gets the current document for use later on
(setq ss (GetBlockSelectionSet "bei*detail*box*")); Select all blocks with the word bei, detail and box in their name (dynamic and non dynamic blocks)
(cond
((or (= (sslength ss) 0) (= ss nil)); If no objects were selected above, ask the user to manually select a block to get the name.
(while (= tst nil)
(setq tst (entsel "\nCould not automatically find detail boxes, please select one manually: "))
)
(setq tst (vlax-ename->vla-object (car tst))
tsttyp (vla-get-objectname tst)
)
(cond
((= tstyp "AcDbBlockReference")
(setq bname (vla-get-name tst)
ss (GetBlockSelectionSet bname)
)
)
)
(cond
((or (= (sslength ss) 0) (= ss nil)); If for some reason the selection set is still empty, ask the user to manually select the blocks that they want to update.
(while (or (= ss nil) (= (sslength ss) 0))
(princ "\rManually select detail boxes: ")
(setq ss (ssget))
)
)
)
)
)
(while (and (/= ss nil) (> (sslength ss) 0)); Loop through all instances of the block(s) to make sure they all get replaced
(setq ent (vlax-ename->vla-object (ssname ss 0)); Make an object out of the first entity in the selection set
obtyp (vla-get-objectname ent); Find the type of object that we are working with
)
(cond
((= obtyp "AcDbBlockReference"); If we are working with a block continue on, otherwise remove the entity and move on to the nect one.
(setq ent2 (vla-InsertBlock (vla-objectidtoobject doc (vla-get-ownerid ent)) (vla-get-insertionpoint ent) "BEI DETAIL BOX - R3B" (vla-get-XScaleFactor ent) (vla-get-yscalefactor ent) (vla-get-zscalefactor ent) (vla-get-rotation ent))); Insert the new block based on how the old block was inserted.
(vla-put-layer ent2 (vla-get-layer ent)); Make sure that the new object is placed on the same layer as the old object
; Code to match dynamic properties adapted from T. Willey's code at http://www.theswamp.org/index.php?topic=31549.msg370876#msg370876
(foreach i (vlax-invoke ent 'getdynamicblockproperties)
(foreach j (vlax-invoke ent2 'getdynamicblockproperties)
(cond
((= (strcase (vla-get-propertyname j)) (strcase (vla-get-PropertyName i)))
(cond
((/= (vla-get-propertyname j) "Origin")
(vla-put-Value j (vla-get-value i))
)
)
)
)
)
(setq j nil)
)
; End of code to match dynamic block properties
; The following code makes sure that attribute values match.
(setq attribs1 (vla-GetAttributes ent)
attrib-list1 (vlax-safearray->list (vlax-variant-value attribs1))
attribs2 (vla-GetAttributes ent2)
attrib-list2 (vlax-safearray->list (vlax-variant-value attribs2))
)
(foreach i attrib-list1
(foreach j attrib-list2
(cond
((= (strcase (vla-get-tagstring j)) (strcase (vla-get-tagstring i)))
(vla-put-textstring j (vla-get-textstring i))
)
)
)
)
; End of attribute code
(vla-delete ent); Delete old object
)
)
(ssdel (ssname ss 0) ss); Remove object from selection set.
)
(princ)
)
;Code to select dynamic blocks from Lee Mac at http://www.theswamp.org/index.php?topic=35754.msg409742#msg409742
(defun GetBlockSelectionSet ( name / ss ss4) (vl-load-com)
(setq ss4 (ssadd))
(if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat name ",`*U*")))))
(
(lambda ( i / e )
(while (setq e (ssname ss (setq i (1+ i))))
(if (wcmatch (strcase (vla-get-EffectiveName (vlax-ename->vla-object e))) (strcase name)); Line modified by Chris Wade to not be case sensitive and to use wild card matching
(ssadd e ss4)
)
)
ss4
)
-1
)
)
)
