;;; ---------------------------------------------------------------------------
;;; TagShed.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Converts attribute definitions (ATTDEF) into plain TEXT objects.
;;;
;;; An ATTDEF carries both a tag name (DXF 2) and a prompt/default value
;;; (DXF 1). What you see on screen in the block editor is the TAG, so the tag
;;; is what gets carried across into the replacement TEXT object.
;;;
;;; Every formatting group that TEXT and ATTDEF share - position, height,
;;; rotation, style, justification, oblique angle, width factor, colour - is
;;; copied straight across, so the replacement text lands in exactly the same
;;; place, at the same size, in the same style.
;;;
;;; Typical use: you have been handed a block full of attribute definitions
;;; that should have been static text all along, and you want to strip the
;;; attribute behaviour without redrawing the annotation.
;;;
;;; COMMAND:  TAGSHED  - convert selected attribute definitions to plain text
;;; ---------------------------------------------------------------------------

;; ---------------------------------------------------------------------------
;; DXF groups carried from the ATTDEF to the new TEXT object.
;;
;;    6  linetype            7  text style        8  layer
;;   10  insertion point    11  alignment point  39  thickness
;;   40  text height        41  width factor     50  rotation
;;   51  oblique angle      62  colour           71  generation flags
;;   72  horizontal just.   73  vertical just.  210  extrusion direction
;;
;; Group 73 means different things on the two entity types - on an ATTDEF it
;; is the vertical justification, which is also its meaning on TEXT, so it
;; transfers cleanly. Group 210 is included so that text on a rotated UCS or
;; on a non-world extrusion keeps its orientation.
;; ---------------------------------------------------------------------------
(setq TagShed:Groups '(6 7 8 10 11 39 40 41 50 51 62 71 72 73 210))

;; ---------------------------------------------------------------------------
;; c:TAGSHED  -  main routine
;; ---------------------------------------------------------------------------
(defun c:TAGSHED ( / *error* vars vals sel idx ent data newdata group tag count )

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

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

    (defun *error* ( msg )
        (TagShed:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** TAGSHED 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")

    ;; -----------------------------------------------------------------------
    ;; ssget returns nil when the user cancels or selects nothing. The original
    ;; version fed that nil straight into sslength, which raised a bad argument
    ;; type error, so the result is tested before use.
    ;; -----------------------------------------------------------------------
    (if (setq sel (ssget '((0 . "ATTDEF"))))
        (progn
            (setq idx   0
                  count 0
            )
            (while (setq ent (ssname sel idx))
                (setq data (entget ent)
                      tag  (cdr (assoc 2 data))
                )

                ;; -----------------------------------------------------------
                ;; Build the replacement entity. The type and the string value
                ;; are fixed; everything else is copied only if the source
                ;; actually carries that group, because entmake rejects a nil
                ;; dotted pair.
                ;; -----------------------------------------------------------
                (setq newdata (list '(0 . "TEXT") (cons 1 tag)))
                (foreach group TagShed:Groups
                    (if (setq group (assoc group data))
                        (setq newdata (cons group newdata))
                    )
                )

                ;; -----------------------------------------------------------
                ;; Only delete the original once the replacement has been
                ;; created successfully. If entmake fails the ATTDEF survives,
                ;; which is far preferable to silently losing annotation.
                ;; -----------------------------------------------------------
                (if (entmake (reverse newdata))
                    (progn (entdel ent)
                           (setq count (1+ count))
                    )
                    (princ (strcat "\nCould not convert attribute definition \"" tag "\" - left unchanged."))
                )
                (setq idx (1+ idx))
            )
            (princ (strcat "\n" (itoa count)
                           " attribute definition"
                           (if (= 1 count) "" "s")
                           " converted to text."
                   )
            )
        )
        (princ "\nNo attribute definitions selected.")
    )

    (TagShed:Restore)
    (princ)
)

(princ)