burst selected block including all nested blocks inside it

[zasanil]

Hello,

I am trying to find a lisp that would burst a selected block (or if nothing is selected it ask to select something). It would burst all nested blocks inside the selection until there are no blocks left.

This is the lisp that I have so far, but it does everything in the entire drawing, and I need it to only do selected blocks. Plus there is no error checking in it.

(defun C:BurstAll (/ sset)
(while (setq sset (ssget "X" '((0 . "INSERT"))))
(sssetfirst nil sset)
(C:Burst)
)
(princ)
)

I've been searching for a few days and have not come across anything that performs like I need it to.

Thanks!

[3wood]

You can try attached EXPLODEALL.vlx, which can explode all levels of nested blocks with some options.

[Lee_Mac · Accepted solution]

Try the following program:

;; Nested Burst  -  Lee Mac
;; Bursts the selected block & all nested blocks found within.

(defun c:nburst ( / *error* sel )

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    (LM:startundo (LM:acdoc))
    (if
        (setq sel
            (LM:ssget "\nSelect block to burst: "
                (list "_+.:E:S:L"
                    (cons '(0 . "INSERT")
                        (
                            (lambda ( / def lst )
                                (while (setq def (tblnext "block" (null def)))
                                    (if (= 4 (logand 4 (cdr (assoc 70 def))))
                                        (setq lst (vl-list* "," (cdr (assoc 2 def)) lst))
                                    )
                                )
                                (if lst (list '(-4 . "<NOT") (cons 2 (apply 'strcat (cdr lst))) '(-4 . "NOT>")))
                            )
                        )
                    )
                )
            )
        )
        (LM:burstnested (vlax-ename->vla-object (ssname sel 0)))
    )
    (LM:endundo (LM:acdoc))
    (princ)
)

;; Burst Nested  -  Lee Mac
;; Bursts the supplied block & all nested blocks found within.
;; obj - [vla] VLA Block Reference Object

(defun LM:burstnested ( obj / col idx lay lin lst obj )
    (if (and (= "AcDbBlockReference" (vla-get-objectname obj))
             (vlax-write-enabled-p obj)
             (not (vl-catch-all-error-p (setq lst (vl-catch-all-apply 'vlax-invoke (list obj 'explode)))))
        )
        (progn
            (setq lay (vla-get-layer obj)
                  col (vla-get-color obj)
                  lin (vla-get-linetype obj)
            )
            (foreach att (vlax-invoke obj 'getattributes)
                (if (vlax-write-enabled-p att)
                    (progn
                        (if (= "0" (vla-get-layer att))
                            (vla-put-layer att lay)
                        )
                        (if (= acbyblock (vla-get-color att))
                            (vla-put-color att col)
                        )
                        (if (= "byblock" (strcase (vla-get-linetype att) t))
                            (vla-put-linetype att lin)
                        )
                    )
                )
                (if (= :vlax-false (vla-get-invisible att))
                    (   (if (and (vlax-property-available-p att 'mtextattribute) (= :vlax-true (vla-get-mtextattribute att)))
                            LM:burst:matt2mtext 
                            LM:burst:att2text
                        )
                        (entget (vlax-vla-object->ename att))
                    )
                )
            )
            (foreach new lst
                (if (vlax-write-enabled-p new)
                    (if (= "AcDbAttributeDefinition" (vla-get-objectname new))
                        (vla-delete new)
                        (progn
                            (if (= "0" (vla-get-layer new))
                                (vla-put-layer new lay)
                            )
                            (if (= acbyblock (vla-get-color new))
                                (vla-put-color new col)
                            )
                            (if (= "byblock" (strcase (vla-get-linetype new) t))
                                (vla-put-linetype new lin)
                            )
                            (LM:burstnested new)
                        )
                    )
                )
            )
            (vla-delete obj)
        )
    )
    (princ)
)

(defun LM:burst:removepairs ( itm lst )
    (vl-remove-if '(lambda ( x ) (member (car x) itm)) lst)
)

(defun LM:burst:remove1stpairs ( itm lst )
    (vl-remove-if '(lambda ( x ) (if (member (car x) itm) (progn (setq itm (vl-remove (car x) itm)) t))) lst)
)
  
(defun LM:burst:att2text ( enx )
    (entmakex
        (append '((0 . "TEXT"))
            (LM:burst:removepairs '(000 002 070 074 100 280)
                (subst (cons 73 (cdr (assoc 74 enx))) (assoc 74 enx) enx)
            )
        )
    )
)

(defun LM:burst:matt2mtext ( enx )
    (entmakex
        (append '((0 . "MTEXT") (100 . "AcDbEntity") (100 . "AcDbMText"))
            (LM:burst:remove1stpairs  '(001 007 010 011 040 041 050 071 072 073 210)
                (LM:burst:removepairs '(000 002 042 043 051 070 074 100 101 102 280 330 360) enx)
            )
        )
    )
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)
(vl-load-com) (princ)

[zasanil]

Hi Lee Mac,

That works great. It's even faster than the normal burst command by a lot.

Is it easy to add a feature where you can select more than one block by dragging a window around a few or using the blocks already selected? The origional one that I had did the whole drawing and your lets you pick a signle block. Either way yours works awesome and fast.

Thanks!

[Lee_Mac · Accepted solution]

Many thanks zasanil -

The program was a modification of my Burst Upgraded program, which I've designed to perform more efficiently than the standard Express Tools BURST command.

Multiple selection is not a problem at all, please try the following:

;; Nested Burst  -  Lee Mac
;; Bursts the selected blocks & all nested blocks found within.

(defun c:nburst ( / *error* idx sel )

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    
    (LM:startundo (LM:acdoc))
    (if
        (setq sel
            (LM:ssget "\nSelect blocks to burst: "
                (list "_:L"
                    (cons '(0 . "INSERT")
                        (
                            (lambda ( / def lst )
                                (while (setq def (tblnext "block" (null def)))
                                    (if (= 4 (logand 4 (cdr (assoc 70 def))))
                                        (setq lst (vl-list* "," (cdr (assoc 2 def)) lst))
                                    )
                                )
                                (if lst (list '(-4 . "<NOT") (cons 2 (apply 'strcat (cdr lst))) '(-4 . "NOT>")))
                            )
                        )
                    )
                )
            )
        )
        (repeat (setq idx (sslength sel))
            (LM:burstnested (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
        )
    )
    (LM:endundo (LM:acdoc))
    (princ)
)

;; Burst Nested  -  Lee Mac
;; Bursts the supplied block & all nested blocks found within.
;; obj - [vla] VLA Block Reference Object

(defun LM:burstnested ( obj / col idx lay lin lst obj )
    (if (and (= "AcDbBlockReference" (vla-get-objectname obj))
             (vlax-write-enabled-p obj)
             (not (vl-catch-all-error-p (setq lst (vl-catch-all-apply 'vlax-invoke (list obj 'explode)))))
        )
        (progn
            (setq lay (vla-get-layer obj)
                  col (vla-get-color obj)
                  lin (vla-get-linetype obj)
            )
            (foreach att (vlax-invoke obj 'getattributes)
                (if (vlax-write-enabled-p att)
                    (progn
                        (if (= "0" (vla-get-layer att))
                            (vla-put-layer att lay)
                        )
                        (if (= acbyblock (vla-get-color att))
                            (vla-put-color att col)
                        )
                        (if (= "byblock" (strcase (vla-get-linetype att) t))
                            (vla-put-linetype att lin)
                        )
                    )
                )
                (if (= :vlax-false (vla-get-invisible att))
                    (   (if (and (vlax-property-available-p att 'mtextattribute) (= :vlax-true (vla-get-mtextattribute att)))
                            LM:burst:matt2mtext 
                            LM:burst:att2text
                        )
                        (entget (vlax-vla-object->ename att))
                    )
                )
            )
            (foreach new lst
                (if (vlax-write-enabled-p new)
                    (if (= "AcDbAttributeDefinition" (vla-get-objectname new))
                        (vla-delete new)
                        (progn
                            (if (= "0" (vla-get-layer new))
                                (vla-put-layer new lay)
                            )
                            (if (= acbyblock (vla-get-color new))
                                (vla-put-color new col)
                            )
                            (if (= "byblock" (strcase (vla-get-linetype new) t))
                                (vla-put-linetype new lin)
                            )
                            (LM:burstnested new)
                        )
                    )
                )
            )
            (vla-delete obj)
        )
    )
    (princ)
)

(defun LM:burst:removepairs ( itm lst )
    (vl-remove-if '(lambda ( x ) (member (car x) itm)) lst)
)

(defun LM:burst:remove1stpairs ( itm lst )
    (vl-remove-if '(lambda ( x ) (if (member (car x) itm) (progn (setq itm (vl-remove (car x) itm)) t))) lst)
)
  
(defun LM:burst:att2text ( enx )
    (entmakex
        (append '((0 . "TEXT"))
            (LM:burst:removepairs '(000 002 070 074 100 280)
                (subst (cons 73 (cdr (assoc 74 enx))) (assoc 74 enx) enx)
            )
        )
    )
)

(defun LM:burst:matt2mtext ( enx )
    (entmakex
        (append '((0 . "MTEXT") (100 . "AcDbEntity") (100 . "AcDbMText"))
            (LM:burst:remove1stpairs  '(001 007 010 011 040 041 050 071 072 073 210)
                (LM:burst:removepairs '(000 002 042 043 051 070 074 100 101 102 280 330 360) enx)
            )
        )
    )
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(vl-load-com) (princ)

[zasanil]

That was quick! It works awesome.

Thank you very much!

[Lee_Mac]

You're welcome Dan

[James.Pascual]

Hi Mr. Lee!  Big fan of your work, your basically everywhere when I research Lisp routines.

I'm trying to combine your burst nested lisp to another lisp to turn all selected entities to another color, but your code is above my skill level to reverse engineer or modify to work with this other code (shown below).  This other code asks the user which color to change everything to, then the user selects the objects and then the code changes all those objects to that color.  My problem is, that there are sometimes blocks / nested blocks in the selection that doesn't have the entities set to "bylayer" or "byblock" so the objects don't actually change color because of the blocks.  I would like to run your burst nested blocks to the selection before turning everything to another color.

(defun c:demo (/ color p1 p2 ss)
   (if (and (progn (initget "Red Yellow Green" 1)
                   (setq color (getkword "\nChange objects to color [Red/Yellow/Green]: "))
            )
            (setq p1 (getpoint "\nSpecify first point: "))
            (setq p2 (getcorner p1 "\nSpecify opposite corner: "))
            (setq ss (ssget "_W" p1 p2))
       )
      (progn
         (command "chprop" ss "" "C" color "")
         (prompt (strcat (itoa (sslength ss)) " Entities were changed to the color " color))
      )
      (prompt "\n No entities selected... ")
   )
   (princ)
)

This is how far I got, but failed:

(defun c:ExcelPrep ( / *error* idx sel ss)

  (setq p1 (getpoint "\nSpecify first point : "))
  (setq p2 (getcorner p1 "\nSpecify opposite corner: "))
  (setq ss (ssget "_W" p1 p2))
  
  (if
    (setq sel
	   (LM:ssget ss "\nSelect blocks to burst: "
                (list "_:L"
                    (cons '(0 . "INSERT")
                        (
                            (lambda ( / def lst )
                                (while (setq def (tblnext "block" (null def)))
                                    (if (= 4 (logand 4 (cdr (assoc 70 def))))
                                        (setq lst (vl-list* "," (cdr (assoc 2 def)) lst))
                                    )
                                )
                                (if lst (list '(-4 . "<NOT") (cons 2 (apply 'strcat (cdr lst))) '(-4 . "NOT>")))
                            )
                        )
                    )
                )
            )
        )
        (repeat (setq idx (sslength sel))
            (LM:burstnested (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
        )
    )
  
  ; change color of all objects within selection to white
  (if (setq sel (ssget "_W" p1 p2))
    (progn
      (command "chprop" sel "" "C" "white" "")
      (prompt (strcat (itoa (sslength sel)) " Entities were changed to the color " color))
      )
    )
  (princ)
)

;; Burst Nested  -  Lee Mac
;; Bursts the supplied block & all nested blocks found within.
;; obj - [vla] VLA Block Reference Object

(defun LM:burstnested ( obj / col idx lay lin lst obj )
    (if (and (= "AcDbBlockReference" (vla-get-objectname obj))
             (vlax-write-enabled-p obj)
             (not (vl-catch-all-error-p (setq lst (vl-catch-all-apply 'vlax-invoke (list obj 'explode)))))
        )
        (progn
            (setq lay (vla-get-layer obj)
                  col (vla-get-color obj)
                  lin (vla-get-linetype obj)
            )
            (foreach att (vlax-invoke obj 'getattributes)
                (if (vlax-write-enabled-p att)
                    (progn
                        (if (= "0" (vla-get-layer att))
                            (vla-put-layer att lay)
                        )
                        (if (= acbyblock (vla-get-color att))
                            (vla-put-color att col)
                        )
                        (if (= "byblock" (strcase (vla-get-linetype att) t))
                            (vla-put-linetype att lin)
                        )
                    )
                )
                (if (= :vlax-false (vla-get-invisible att))
                    (   (if (and (vlax-property-available-p att 'mtextattribute) (= :vlax-true (vla-get-mtextattribute att)))
                            LM:burst:matt2mtext 
                            LM:burst:att2text
                        )
                        (entget (vlax-vla-object->ename att))
                    )
                )
            )
            (foreach new lst
                (if (vlax-write-enabled-p new)
                    (if (= "AcDbAttributeDefinition" (vla-get-objectname new))
                        (vla-delete new)
                        (progn
                            (if (= "0" (vla-get-layer new))
                                (vla-put-layer new lay)
                            )
                            (if (= acbyblock (vla-get-color new))
                                (vla-put-color new col)
                            )
                            (if (= "byblock" (strcase (vla-get-linetype new) t))
                                (vla-put-linetype new lin)
                            )
                            (LM:burstnested new)
                        )
                    )
                )
            )
            (vla-delete obj)
        )
    )
    (princ)
)

(defun LM:burst:removepairs ( itm lst )
    (vl-remove-if '(lambda ( x ) (member (car x) itm)) lst)
)

(defun LM:burst:remove1stpairs ( itm lst )
    (vl-remove-if '(lambda ( x ) (if (member (car x) itm) (progn (setq itm (vl-remove (car x) itm)) t))) lst)
)
  
(defun LM:burst:att2text ( enx )
    (entmakex
        (append '((0 . "TEXT"))
            (LM:burst:removepairs '(000 002 070 074 100 280)
                (subst (cons 73 (cdr (assoc 74 enx))) (assoc 74 enx) enx)
            )
        )
    )
)

(defun LM:burst:matt2mtext ( enx )
    (entmakex
        (append '((0 . "MTEXT") (100 . "AcDbEntity") (100 . "AcDbMText"))
            (LM:burst:remove1stpairs  '(001 007 010 011 040 041 050 071 072 073 210)
                (LM:burst:removepairs '(000 002 042 043 051 070 074 100 101 102 280 330 360) enx)
            )
        )
    )
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( ss msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg)))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)

(vl-load-com) (princ)

Can you help?

[gabriele.caccin]

Hello everyone,

I read all posts (and macros) that you wrote.

Many of these solved part of my following request and then I'll ask you if is possibile to modify one of these macro.

Unfortunatly I'm an Advance Steel expert, but not for AutoCAD macro. 😉

I search a simple macro that:

• Open the dwg file (2D)
• Explode each block inside, until the 2° level block nested (not the first) 
• Delete all lines less than 5 mm
• Purge all
• Close and save the file

I would obtain one dwg file more light than the first, with some blocks having one level blocks nested inside.

Is it possibile to make these operation?

Thanks in advance and I'll very happy to return the favor .

[3wood]

To manually delete lines less than 5mm, you can use QSELECT.

[gabriele.caccin]

Thanks 3wood,

I know very well this command, but I need to merge all these steps in a macro, in order to run it on a big 2D drawing that it contains a lot of nested blocks.

Thank you in advance. Regards.

[brian.lin7NXYA]

hello, Lee, i am your big fans.

is it possible to explode all nested blocks but remain the first level block?

[kalakar1966]

Is it possible explode all nested blocks except the elements are same layer ?