This is another attempt at figuring out what the person on the Ad Ng wants, but I think I have it figured out, but there is one issue that I don't really understand, as I don't delete any object in the code. Below is most of the message I posted over there. The code is supposed to mimic laywalk, but with blocks. It did it on my test drawing. It's slow at the beginning because it is gathering all the info to run the other part of the code, but once the initial setup is done it is pretty quick. Then putting the drawing back the way it was is a little slow also.
That was even funny to me when typing it. Oh well..... what can you do. Let me know what you think.
In the middle of testing right now, as it seems to delete some objects when it shouldn't and I can't figure out why, but it seems to do what you want besides that, so if you test it, don't use it on a drawing you want to save. I think it has something to do with hatch patterns, and their boundaries, but that is just a guess right now. Here is the code, and the dcl file is attached, which is the same as the previous dcl file, just using a different dcl from there.
Edit: Update code. Works with nested blocks, xrefs and dynamic blocks. Little slow at beginning and ending, since I have to regen ( update ) each object instead using the Regen method, but it works better this way, as it won't create new blocks for dynamic ones. As usual, let me know how it works for you. I might even keep/use this one myself.
(vl-load-com)
(defun c:BlockWalk (/ *error* VisList ActDoc LayList NestInsList OldNum cLay tempList BlkList MainName XdataInfo tempName NestWithInList NestList InsList tempVisList )
(defun *error* (msg)
(foreach i VisList
(vla-put-Visible (car i) (cdr i))
)
(vlax-for lo (vla-get-Layouts ActDoc)
(vlax-for i (vla-get-Block lo)
(vla-Update i)
)
)
(foreach i LayList
(vla-put-LayerOn (car i) (cadr i))
(if (/= (vla-get-Name (car i)) cLay)
(vla-put-Freeze (car i) (caddr i))
)
(vla-put-Lock (car i) (cadddr i))
)
(foreach i NestInsList
(vla-put-Visible i :vlax-true)
)
(if msg (vl-bt))
)
;--------------------------------------------------------------------
(defun GetLayInfo ( doc / ObjList )
(vlax-for obj (vla-get-Layers doc)
(setq ObjList
(cons
(list
obj
(vla-get-LayerOn obj)
(vla-get-Freeze obj)
(vla-get-Lock obj)
)
ObjList
)
)
(vla-put-LayerOn obj :vlax-true)
(if (/= (vla-get-Name obj) cLay)
(vla-put-Freeze obj :vlax-false)
)
(vla-put-Lock obj :vlax-false)
)
ObjList
)
;-----------------------------------------------------------------------
(defun SelectBlock ( Listof / DiaLoad )
(setq DiaLoad (load_dialog "MyDialogs.dcl"))
(if (new_dialog "MyPropsList" DiaLOad)
(progn
(start_list "PropsListbox2" 3)
(mapcar 'add_list Listof)
(end_list)
(action_tile "PropsListbox2"
"(if (= $reason 1)
(progn
(mode_tile \"PropsListbox2\" 1)
(UpdateDrawing (atoi (get_tile \"PropsListbox2\")))
(mode_tile \"PropsListbox2\" 0)
(mode_tile \"PropsListbox2\" 2)
)
)"
)
(action_tile "cancel" "(done_dialog 0)")
(start_dialog)
)
)
)
;-------------------------------------------------------------
(defun UpdateDrawing ( num / tempList )
(if OldNum
(progn
(setq tempList (nth OldNum BlkList))
(foreach i (cdr tempList)
(vla-put-Visible i :vlax-false)
)
(if (setq tempList (assoc (car tempList) InsList))
(foreach i (cdr tempList)
(foreach att (append (vlax-invoke i 'GetAttributes) (vlax-invoke i 'GetConstantAttributes))
(vla-put-Visible att :vlax-false)
)
(vla-Update i)
)
)
)
)
(foreach i NestInsList
(vla-put-Visible i :vlax-false)
)
(setq NestInsList nil)
(setq tempList (nth num BlkList))
(foreach i (cdr tempList)
(vla-put-Visible i :vlax-true)
)
(if (setq tempList (assoc (car tempList) InsList))
(foreach i (cdr tempList)
(foreach att (append (vlax-invoke i 'GetAttributes) (vlax-invoke i 'GetConstantAttributes))
(vla-put-Visible att :vlax-true)
)
(vla-Update i)
)
)
(MakeBlockVisible (car tempList))
(setq OldNum num)
)
;------------------------------------------------------------------------
(defun MyGetXData (Obj DataName / CodeType DataType)
; Retrive XData for an object
(vla-GetXData
Obj
(if DataName
DataName
""
)
'CodeType
'DataType
)
(if (and CodeType DataType)
(mapcar
'(lambda (a b)
(cons a (variant-value b))
)
(safearray-value CodeType)
(safearray-value DataType)
)
)
)
;------------------------------------------------------------------------
(defun MakeInsertsVisible ( name )
(foreach i (cdr (assoc name InsList))
(vla-put-Visible i :vlax-true)
(vla-Update i)
(setq NestInsList (cons i NestInsList))
)
(foreach i (cdr (assoc name NestWithInList))
(MakeInsertsVisible i)
)
)
;---------------------------------------------------------------------
(defun MakeBlockVisible ( name )
(foreach i (cdr (assoc name BlkList))
(vla-put-Visible i :vlax-true)
(vla-Update i)
(setq NestInsList (cons i NestInsList))
)
(MakeInsertsVisible name)
(foreach i (cdr (assoc name NestList))
(MakeBlockVisible i)
(MakeInsertsVisible i)
)
)
;---------------------------------------------------------------------
(setq cLay (getvar 'CLayer))
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(setq LayList (GetLayInfo ActDoc))
(vlax-for blk (vla-get-Blocks ActDoc)
(cond
((equal (vla-get-IsLayout blk) :vlax-true)
)
((not (wcmatch (vla-get-Name blk) "`*D*"))
(setq tempVisList nil)
(setq BlkList
(cons
(cons
(setq MainName
(if (setq XdataInfo (MyGetXData blk "AcDbBlockRepBTag"))
(strcat (vla-get-Name (vla-HandleToObject ActDoc (cdr (assoc 1005 XdataInfo)))) " _-_ ( " (vla-get-Name blk) " )")
(vla-get-Name blk)
)
)
(progn
(vlax-for i blk
(setq VisList (cons (cons i (vla-get-Visible i)) VisList))
(if (equal (vla-get-Visible i) :vlax-true)
(setq tempVisList (cons i tempVisList))
)
(if (= (vla-get-ObjectName i) "AcDbBlockReference")
(progn
(vla-put-Visible i :vlax-true)
(setq tempName
(if
(and
(vlax-property-available-p i 'EffectiveName)
(/= (vla-get-EffectiveName i) (vla-get-Name i))
)
(strcat (vla-get-EffectiveName i) " _-_ ( " (vla-get-Name i) " )")
(vla-get-Name i)
)
)
(if (setq tempList (assoc tempName NestWithInList))
(if (not (member MainName tempList))
(setq NestWithInList (subst (cons tempName (cons MainName (cdr tempList))) tempList NestWithInList))
)
(setq NestWithInList (cons (list tempName MainName) NestWithInList))
)
(setq NestList
(if (setq tempList (assoc MainName NestList))
(subst (cons MainName (cons tempName (cdr NestList))) tempList NestList)
(cons (list MainName tempName) NestList)
)
)
(setq InsList
(if (setq tempList (assoc tempName InsList))
(subst (cons tempName (cons i (cdr tempList))) tempLIst InsList)
(cons (list tempName i) InsList)
)
)
(foreach att (append (vlax-invoke i 'GetAttributes) (vlax-invoke i 'GetConstantAttributes))
(setq VisList (cons (cons att (vla-get-Visible att)) VisList))
(vla-put-Visible att :vlax-false)
)
)
(vla-put-Visible i :vlax-false)
)
)
tempVisList
)
)
BlkList
)
)
)
)
)
(vlax-for lo (vla-get-Layouts ActDoc)
(vlax-for i (vla-get-Block lo)
(setq VisList (cons (cons i (vla-get-Visible i)) VisList))
(if (= (vla-get-ObjectName i) "AcDbBlockReference")
(progn
(vla-put-Visible i :vlax-true)
(setq tempName
(if
(and
(vlax-property-available-p i 'EffectiveName)
(/= (vla-get-EffectiveName i) (vla-get-Name i))
)
(strcat (vla-get-EffectiveName i) " _-_ ( " (vla-get-Name i) " )")
(vla-get-Name i)
)
)
(setq InsList
(if (setq tempList (assoc tempName InsList))
(subst (cons tempName (cons i (cdr tempList))) tempLIst InsList)
(cons (list tempName i) InsList)
)
)
(foreach att (append (vlax-invoke i 'GetAttributes) (vlax-invoke i 'GetConstantAttributes))
(setq VisList (cons (cons att (vla-get-Visible att)) VisList))
(vla-put-Visible att :vlax-false)
)
)
(vla-put-Visible i :vlax-false)
)
(vla-Update i)
)
)
(setq BlkList
(vl-sort
(vl-remove-if-not
(function
(lambda ( x )
(assoc (car x) InsList)
)
)
BlkList
)
(function
(lambda ( a b )
(< (strcase (car a)) (strcase (car b)))
)
)
)
)
(SelectBlock (mapcar (function car) BlkList))
(*error* nil)
(princ)
)
