Edit: Massive revamp inspired by RJP - thanks RJP!
(Google translator...)
Grazie Michael to share your functions always very interesting and useful ... I take a cue from this topic to ask a question that can be solved with a similar function (maybe it already exists).
Below is a simplified version of
http://www.lee-mac.com/addobjectstoblock.html (no vla-transformby by Matrix)
> found two potentially dangerous situations that cause the CAD to crash for recursive block creation:
1 - if the block to be modified is included in the selection of new objects to be added (can be solved see > Level1)
2 - if among the selected objects there is a block that contains the block to be modified (which is less easy to avoid)
The block command anticipates these situations and aborts the command with a warning message.
Problem: find if in the selection of objects to add there is a block that contains (at any level) the block to which the objects are being added.
(defun C:ALE_Block_Cmd_AddObj ( / BlkEnt ObjLst SelLst SelSet Countr EntObj acdoc)
(if
(and
(setq SelLst (entsel "Select Block:"))
(not (prompt "\nSelect Objects to add\n"))
(setq SelSet (ssget "_:L"))
)
(progn
(setq
acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
BlkEnt (car SelLst)
BlkNam (cdr (assoc 2 (entget BlkEnt)))
)
(prompt (strcat "\n" BlkNam))
(and
(ssmemb BlkEnt SelSet)
(progn
(setq SelSet (ssdel BlkEnt SelSet))
(alert "The original block was also selected from the objects to be added.\nThe block selection was ignored."); > Level1
)
); crash if present BlkEnt
(repeat (setq Countr (sslength SelSet))
(setq EntObj (vlax-ename->vla-object (ssname SelSet (setq Countr (1- Countr)))))
(if
(and
(= "AcDbBlockReference" (vlax-get EntObj 'ObjectName))
(= BlkNam (vlax-get EntObj 'Name))
)
(alert "A copy of the original block was also selected from the objects to be added.\nThe block selection was ignored."); > Level1
(setq ObjLst (cons EntObj ObjLst))
)
)
(vla-CopyObjects acdoc (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length ObjLst)))) ObjLst))
(vla-item (vla-get-Blocks acdoc) (cdr (assoc 2 (entget BlkEnt))))
)
(foreach ObjFor ObjLst (vla-delete ObjFor))
(vla-regen acdoc acAllViewports)
)
)
(princ)
)