;;; ---------------------------------------------------------------------------
;;; AttClone.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Copies the FORMATTING of one attribute onto other attributes.
;;;
;;; Pick a source attribute whose appearance is correct, then keep picking
;;; attributes that should look the same. Height, style, layer, rotation,
;;; oblique angle, width factor, colour-bearing properties and the two mirror
;;; flags are all carried across.
;;;
;;; WHAT IS NOT COPIED - AND WHY
;;; The attribute's VALUE is deliberately left alone. This matters: attributes
;;; are how drawings carry real data - door numbers, room names, title block
;;; fields - and a tool that silently overwrote that data while claiming to fix
;;; formatting would be genuinely dangerous. Only appearance is touched.
;;;
;;; Both prompts use nested selection, so attributes are picked directly inside
;;; their block references without anyone having to explode anything.
;;;
;;; THE PROPERTY LIST IS MEANT TO BE EDITED
;;; AttClone:Properties below is a plain list of ActiveX property names. Delete
;;; a line to stop that property being copied, or add one to include something
;;; else the attribute exposes. Run XRAY on an attribute to see the full set of
;;; names available.
;;;
;;;   ATTCLONE  - match attribute formatting from a source to many targets
;;; ---------------------------------------------------------------------------

(vl-load-com)

;; ---------------------------------------------------------------------------
;; Properties transferred from source to target. Edit freely - see the note in
;; the header. Deliberately excludes TextString, which holds the value.
;; ---------------------------------------------------------------------------
(setq AttClone:Properties
   '(
        Backward           ; mirrored horizontally
        Height             ; text height
        Layer
        Linetype
        LinetypeScale
        Lineweight
        ObliqueAngle       ; slant, for italicised annotation
        Rotation
        ScaleFactor        ; width factor
        StyleName          ; text style
        Thickness
        UpsideDown         ; mirrored vertically
    )
)

;; ---------------------------------------------------------------------------
;; AttClone:PickAttribute
;; ---------------------------------------------------------------------------
;; Prompts repeatedly until the user picks something that really is an
;; attribute, or presses Enter to stop.
;;
;; The loop continues while nentsel returns an entity that fails the test, so
;; clicking a line or a piece of plain text produces a complaint and another
;; prompt rather than either an error or a silent no-op. Pressing Enter or
;; Escape returns nil and ends the loop.
;;
;; msg - [str] the prompt to display
;; Returns the attribute's entity name, or nil.
;; ---------------------------------------------------------------------------
(defun AttClone:PickAttribute ( msg / ent )
    (while
        (progn
            (setq ent (car (nentsel msg)))
            (cond
                ;; nil means Enter or Escape - stop asking.
                (   (null ent)
                    nil
                )
                ;; Right type: stop asking and keep it.
                (   (= "ATTRIB" (cdr (assoc 0 (entget ent))))
                    nil
                )
                ;; Anything else: complain and go round again.
                (   t
                    (princ "\nThat is not an attribute - try again.")
                    t
                )
            )
        )
    )
    ent
)

;; ---------------------------------------------------------------------------
;; AttClone:ReadProperties
;; ---------------------------------------------------------------------------
;; Reads the listed properties from the source object and returns their values
;; in the same order.
;;
;; Each read is guarded, because not every attribute exposes every property -
;; an annotative attribute, or one inside a dynamic block, can lack some of
;; them. A property that cannot be read yields nil, and nil values are skipped
;; when writing, so one missing property does not abort the whole operation.
;; ---------------------------------------------------------------------------
(defun AttClone:ReadProperties ( obj props )
    (mapcar
        (function
            (lambda ( prop / result )
                (setq result (vl-catch-all-apply 'vlax-get-property (list obj prop)))
                (if (vl-catch-all-error-p result) nil result)
            )
        )
        props
    )
)

;; ---------------------------------------------------------------------------
;; AttClone:WriteProperties
;; ---------------------------------------------------------------------------
;; Writes the captured values onto a target object.
;;
;; Returns the number of properties successfully applied. Writes are guarded
;; individually so that a target which refuses one property - a locked layer, a
;; property that is read-only on that particular attribute - still receives all
;; the others.
;; ---------------------------------------------------------------------------
(defun AttClone:WriteProperties ( obj props vals / count )
    (setq count 0)
    (mapcar
        (function
            (lambda ( prop val )
                (if (and val
                         (not (vl-catch-all-error-p
                                  (vl-catch-all-apply 'vlax-put-property (list obj prop val))
                              )
                         )
                    )
                    (setq count (1+ count))
                )
            )
        )
        props vals
    )
    count
)

;; ---------------------------------------------------------------------------
;; c:ATTCLONE  -  main routine
;; ---------------------------------------------------------------------------
(defun c:ATTCLONE ( / *error* vars vals source values target count )

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

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

    (setvar "CMDECHO" 0)

    ;; Every target edit belongs in one undo group, so a single U reverses the
    ;; whole session of matching rather than one attribute at a time.
    ;; 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")

    (if (setq source (AttClone:PickAttribute "\nSelect source attribute: "))
        (progn
            ;; Read the source once, up front. Reading it inside the target
            ;; loop would be wasteful, and would also mean that accidentally
            ;; matching the source onto itself could alter what is being copied
            ;; part way through.
            (setq values (AttClone:ReadProperties
                             (vlax-ename->vla-object source)
                             AttClone:Properties
                         )
                  count  0
            )

            (while (setq target (AttClone:PickAttribute "\nSelect attribute to match <exit>: "))
                (AttClone:WriteProperties
                    (vlax-ename->vla-object target)
                    AttClone:Properties
                    values
                )
                (setq count (1+ count))
            )

            (princ (strcat "\n" (itoa count)
                           " attribute" (if (= 1 count) "" "s") " matched."
                   )
            )
        )
        (princ "\n*Cancelled* - no source attribute selected.")
    )

    (AttClone:Restore)
    (princ)
)

(princ)