[编程交流] 仅分解嵌套块

(defun C:test ( / o n L b)
 
 (defun Bdef->SubentsL ( nm / e L )
   (setq e (cdr (assoc -2 (entget (tblobjname "BLOCK" nm)))))
   (while e (setq L (cons e L)) (setq e (entnext e))) L
 )
 
 (and 
   (setq n (car (entsel "\nSelect block to "flatten": ")))
   (setq n (vlax-ename->vla-object n))
   (setq n (vla-get-EffectiveName n))
   (progn 
     (while 
       (vl-some 
         (function
           (lambda (x / o) 
             (and 
               (= "INSERT" (cdr (assoc 0 x))) 
               (setq L (cons (cdr (assoc 2 x)) L))
               (setq o (vlax-ename->vla-object (cdr (assoc -1 x))))
               (vlax-write-enabled-p o)
               (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-Explode (list o))))
               (not (vla-Delete o))
             )
           )
         )
         (mapcar 'entget (Bdef->SubentsL n))
       )
     ); while
     (and (= "Yes" (progn (initget "Yes No") (cond ((getkword "\nAttempt to purge the SubBlocks? [Yes/No] <Yes>: ")) ("Yes"))))
       (setq b (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))))
       (foreach x L (vl-catch-all-apply 'vla-Delete (list (vla-item b x))) )
     ); and
   ); progn
 ); and
 
 (princ)
); defun