;;; ---------------------------------------------------------------------------
;;; SmartBurst.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Explodes blocks while keeping their attribute VALUES as text - a better
;;; behaved replacement for the Express Tools BURST command.
;;;
;;; COMMANDS
;;;   SMARTBURST     - burst the selected blocks only
;;;   SMARTBURSTALL  - burst them and every block nested inside them, to any
;;;                    depth
;;;
;;; WHAT IT FIXES ABOUT EXPRESS BURST
;;;
;;;   Invisible attributes stay invisible. Express BURST reveals attributes the
;;;   block author deliberately hid, splattering internal data across the
;;;   drawing. Both the attribute's own invisible flag and its Visible property
;;;   are checked here.
;;;
;;;   Visible CONSTANT attributes are kept. Express BURST discards them, losing
;;;   annotation that was plainly on screen a moment earlier. Constant
;;;   attributes exist as definitions rather than as instances, so they need
;;;   handling separately - which is what the attribute-definition branch does.
;;;
;;;   Hidden dynamic block geometry is removed. Exploding a dynamic block
;;;   produces the geometry of EVERY visibility state, not just the one on
;;;   display. Anything coming back invisible is deleted rather than dumped
;;;   into the drawing.
;;;
;;;   Attribute transparency survives. DXF group 440 carries transparency and
;;;   is preserved through the conversion.
;;;
;;;   BYBLOCK properties are resolved. Objects drawn on layer 0, or with
;;;   BYBLOCK colour or linetype, inherit from the block reference - which
;;;   ceases to exist once burst. Their inherited values are written onto them
;;;   first, so the drawing looks identical afterwards.
;;;
;;; XREFS ARE EXCLUDED, at both levels: the selection filter removes xref
;;; definitions, and the recursive pass skips anything with a Path property.
;;;
;;; FOR YOUR OWN CODE
;;; SmartBurst:Selection takes a selection set and a nested flag, so it can be
;;; called directly from other routines.
;;; ---------------------------------------------------------------------------

(vl-load-com)

;; ---------------------------------------------------------------------------
;; SmartBurst:Doc  -  cached active document
;; ---------------------------------------------------------------------------
(defun SmartBurst:Doc nil
    (eval (list 'defun 'SmartBurst:Doc 'nil
                (vla-get-activedocument (vlax-get-acad-object))
          )
    )
    (SmartBurst:Doc)
)

;; ---------------------------------------------------------------------------
;; SmartBurst:UniformlyScaled
;; ---------------------------------------------------------------------------
;; True if the block reference is scaled equally in X, Y and Z.
;;
;; The scale factors are compared as ABSOLUTE values, so a mirrored block -
;; which carries a negative factor on one axis but is still uniformly scaled -
;; is correctly recognised and can take the fast explode path.
;;
;; The property name differs between AutoCAD versions; it is resolved once and
;; this function then replaces itself.
;; ---------------------------------------------------------------------------
(defun SmartBurst:UniformlyScaled ( obj / prop )
    (if (vlax-property-available-p obj 'xeffectivescalefactor)
        (setq prop "effectivescalefactor")
        (setq prop "scalefactor")
    )
    (eval
        (list 'defun 'SmartBurst:UniformlyScaled '( obj )
            (list 'and
                (list 'equal
                      (list 'abs (list 'vlax-get-property 'obj (strcat "x" prop)))
                      (list 'abs (list 'vlax-get-property 'obj (strcat "y" prop)))
                      1e-8
                )
                (list 'equal
                      (list 'abs (list 'vlax-get-property 'obj (strcat "x" prop)))
                      (list 'abs (list 'vlax-get-property 'obj (strcat "z" prop)))
                      1e-8
                )
            )
        )
    )
    (SmartBurst:UniformlyScaled obj)
)

;; ---------------------------------------------------------------------------
;; SmartBurst:LastEntity
;; ---------------------------------------------------------------------------
;; Returns the genuinely last object in the database, including sub-entities -
;; entlast alone stops at the last top-level entity.
;; ---------------------------------------------------------------------------
(defun SmartBurst:LastEntity ( / ent tmp )
    (setq ent (entlast))
    (while (setq tmp (entnext ent)) (setq ent tmp))
    ent
)

;; ---------------------------------------------------------------------------
;; DXF-pair filtering helpers.
;; ---------------------------------------------------------------------------

;; Removes every pair whose group code is listed.
(defun SmartBurst:RemovePairs ( codes lst )
    (vl-remove-if (function (lambda ( x ) (member (car x) codes))) lst)
)

;; Removes only the FIRST occurrence of each listed code - necessary because
;; MText repeats several codes with different meanings.
(defun SmartBurst:RemoveFirstPairs ( codes lst )
    (vl-remove-if
        (function
            (lambda ( x )
                (if (member (car x) codes)
                    (progn (setq codes (vl-remove (car x) codes)) t)
                )
            )
        )
        lst
    )
)

;; ---------------------------------------------------------------------------
;; SmartBurst:ToText
;; ---------------------------------------------------------------------------
;; Creates a TEXT object from single-line attribute data.
;;
;; Group 74 is substituted into group 73 first: vertical justification is
;; stored under 74 on an attribute and under 73 on text, and missing this makes
;; every converted attribute jump vertically.
;;
;; Group 440 (transparency) is stripped, because a transparency value valid on
;; an attribute is not accepted on text and would make entmakex fail silently.
;; ---------------------------------------------------------------------------
(defun SmartBurst:ToText ( enx )
    (entmakex
        (append '((0 . "TEXT"))
            (SmartBurst:RemovePairs '(000 002 003 070 074 100 280 440)
                (subst (cons 73 (cdr (assoc 74 enx))) (assoc 74 enx) enx)
            )
        )
    )
)

;; ---------------------------------------------------------------------------
;; SmartBurst:ToMText
;; ---------------------------------------------------------------------------
;; Creates an MTEXT object from multi-line attribute data.
;;
;; The code list to strip differs between an ATTDEF and an ATTRIB, because a
;; definition also carries group 3 (the prompt string) which an instance does
;; not - and leaving it in would prepend the prompt to the visible text.
;;
;; Group 11 is appended from the REVERSED data at the end: an attribute carries
;; two group 11 entries with different meanings, and it is the last one that
;; holds the MText direction vector.
;; ---------------------------------------------------------------------------
(defun SmartBurst:ToMText ( enx )
    (entmakex
        (append '((0 . "MTEXT") (100 . "AcDbEntity") (100 . "AcDbMText"))
            (SmartBurst:RemoveFirstPairs
                (if (= "ATTDEF" (cdr (assoc 0 enx)))
                   '(001 003 007 010 040 041 050 071 072 073 210)
                   '(001 007 010 040 041 050 071 072 073 210)
                )
                (SmartBurst:RemovePairs
                   '(000 002 011 042 043 051 070 074 100 101 102 280 330 360 440)
                    enx
                )
            )
            (list (assoc 011 (reverse enx)))
        )
    )
)

;; ---------------------------------------------------------------------------
;; SmartBurst:Object
;; ---------------------------------------------------------------------------
;; Bursts a single block reference.
;;
;; obj - [vla-object] the block reference
;; nst - [boolean] T to recurse into nested blocks
;; ---------------------------------------------------------------------------
(defun SmartBurst:Object ( obj nst / cmd col ent err lay lin lst qaf tmp )
    (if
        (and
            (= "AcDbBlockReference" (vla-get-objectname obj))
            ;; An xref reference exposes a Path property; a normal block does
            ;; not. This is what excludes nested xrefs during recursion.
            (not (vlax-property-available-p obj 'path))
            (vlax-write-enabled-p obj)
            (or
                ;; Fast path via ActiveX, for uniformly scaled blocks.
                (and (SmartBurst:UniformlyScaled obj)
                     (not (vl-catch-all-error-p
                              (setq err (vl-catch-all-apply 'vlax-invoke (list obj 'explode)))
                          )
                     )
                     (setq lst err)
                )
                ;; Fallback for non-uniform scaling: explode a temporary copy
                ;; with the command and collect what appears after it.
                (progn
                    (setq tmp (vla-copy obj)
                          ent (SmartBurst:LastEntity)
                          cmd (getvar 'cmdecho)
                          qaf (getvar 'qaflags)
                    )
                    (setvar 'cmdecho 0)
                    (setvar 'qaflags 0)     ; suppress EXPLODE's own prompts
                    (vl-cmdf "_.explode" (vlax-vla-object->ename tmp))
                    (setvar 'qaflags qaf)
                    (setvar 'cmdecho cmd)
                    (while (setq ent (entnext ent))
                        (setq lst (cons (vlax-ename->vla-object ent) lst))
                    )
                    lst
                )
            )
        )
        (progn
            ;; Properties that children may be inheriting from this reference.
            (setq lay (vla-get-layer    obj)
                  col (vla-get-color    obj)
                  lin (vla-get-linetype obj)
            )

            ;; ---------------------------------------------------------------
            ;; Variable attributes. Both visibility tests must pass: Invisible
            ;; is the attribute's own hidden flag, Visible is the object-level
            ;; one that a dynamic block's visibility state controls.
            ;; ---------------------------------------------------------------
            (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 (and (= :vlax-false (vla-get-invisible att))
                         (= :vlax-true  (vla-get-visible   att))
                    )
                    (   (if (and (vlax-property-available-p att 'mtextattribute)
                                 (= :vlax-true (vla-get-mtextattribute att))
                            )
                            SmartBurst:ToMText
                            SmartBurst:ToText
                        )
                        (entget (vlax-vla-object->ename att))
                    )
                )
            )

            ;; ---------------------------------------------------------------
            ;; Everything the explode produced.
            ;; ---------------------------------------------------------------
            (foreach new lst
                (cond
                    (   (not (vlax-write-enabled-p new)))

                    ;; Invisible geometry from an unselected dynamic block
                    ;; visibility state - discard it.
                    (   (= :vlax-false (vla-get-visible new))
                        (vla-delete new)
                    )

                    (   t
                        (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))

                        (if (= "AcDbAttributeDefinition" (vla-get-objectname new))
                            (progn
                                ;; A visible CONSTANT attribute definition is
                                ;; real annotation and is converted to text; a
                                ;; variable one is only a template and is not.
                                (if (and (= :vlax-true  (vla-get-constant  new))
                                         (= :vlax-false (vla-get-invisible new))
                                    )
                                    (   (if (and (vlax-property-available-p new 'mtextattribute)
                                                 (= :vlax-true (vla-get-mtextattribute new))
                                            )
                                            SmartBurst:ToMText
                                            SmartBurst:ToText
                                        )
                                        (entget (vlax-vla-object->ename new))
                                    )
                                )
                                (vla-delete new)
                            )
                            ;; Recurse only when nested bursting was requested.
                            (if nst (SmartBurst:Object new nst))
                        )
                    )
                )
            )

            (vla-delete obj)
        )
    )
)

;; ---------------------------------------------------------------------------
;; SmartBurst:Selection
;; ---------------------------------------------------------------------------
;; Bursts every block in a selection set. Callable from your own routines.
;;
;; sel - [pickset] blocks to burst
;; nst - [boolean] T to also burst nested blocks
;; ---------------------------------------------------------------------------
(defun SmartBurst:Selection ( sel nst / idx )
    (if (= 'pickset (type sel))
        (repeat (setq idx (sslength sel))
            (SmartBurst:Object
                (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
                nst
            )
        )
    )
    (princ)
)

;; ---------------------------------------------------------------------------
;; SmartBurst:XrefFilter
;; ---------------------------------------------------------------------------
;; Returns a filter clause excluding every xref-dependent block definition, or
;; nil if the drawing has none. Bit 4 of a block record's DXF 70 marks an xref.
;; ---------------------------------------------------------------------------
(defun SmartBurst:XrefFilter ( / 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>"))
    )
)

;; ---------------------------------------------------------------------------
;; SmartBurst:Run
;; ---------------------------------------------------------------------------
;; Shared implementation for both commands.
;;
;; nst - [boolean] T to burst nested blocks as well
;; ---------------------------------------------------------------------------
(defun SmartBurst:Run ( nst / *error* vars vals sel count )

    (setq vars '("CMDECHO" "NOMUTT" "QAFLAGS")
          vals (mapcar 'getvar vars)
    )

    (defun SmartBurst:Restore ( )
        (mapcar 'setvar vars vals)
        (while (= 8 (logand 8 (getvar 'undoctl)))
            (command "_.UNDO" "_End")
            (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        )
        (princ)
    )

    (defun *error* ( msg )
        (SmartBurst:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** SMARTBURST error: " msg " **"))
        )
        (princ)
    )

    (setvar "CMDECHO" 0)
    ;; AutoCAD 2015 and later refuse (command) inside an *error* handler
    ;; unless the routine says up front that it will use one. Restore does,
    ;; to close this undo group. The declaring call is absent on older
    ;; releases, so it is wrapped rather than tested for.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")

    ;; NOMUTT is suppressed so the custom prompt is the only one shown, then
    ;; restored to its captured value - the original reset it to a literal 0.
    (princ "\nSelect blocks to burst: ")
    (setvar 'nomutt 1)
    (setq sel
        (vl-catch-all-apply 'ssget
            (list "_:L"
                (append '((0 . "INSERT"))
                        (SmartBurst:XrefFilter)
                        (if (= 1 (getvar 'cvport))
                            (list (cons 410 (getvar 'ctab)))
                           '((410 . "Model"))
                        )
                )
            )
        )
    )
    (setvar 'nomutt (cadr vals))

    (if (and sel (not (vl-catch-all-error-p sel)))
        (progn
            (setq count (sslength sel))
            (SmartBurst:Selection sel nst)
            (princ (strcat "\n" (itoa count)
                           " block" (if (= 1 count) "" "s") " burst"
                           (if nst " (including nested blocks)." ".")
                   )
            )
        )
        (princ "\nNothing selected.")
    )

    (SmartBurst:Restore)
    (princ)
)

;; ---------------------------------------------------------------------------
;; Command wrappers
;; ---------------------------------------------------------------------------
(defun c:SMARTBURST    nil (SmartBurst:Run nil))   ; selected blocks only
(defun c:SMARTBURSTALL nil (SmartBurst:Run   t))   ; including nested blocks

(princ)