;;; ---------------------------------------------------------------------------
;;; FieldGraft.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Copies a FIELD from one annotation object onto many others, keeping the
;;; field live rather than pasting its current value as flat text.
;;;
;;; Pick a source object containing a field, then keep picking destinations.
;;; Each one receives the same field expression and is updated immediately, so
;;; they all display the live value and all keep tracking it.
;;;
;;; Works with Text, MText, attributes, multileaders and dimensions - and the
;;; source and destination need not be the same type, so a field from an MText
;;; can be grafted straight into a dimension override.
;;;
;;; WHY THE FIELD HAS TO BE REBUILT RATHER THAN COPIED
;;; A field is not held in the object you can see. The object stores a
;;; placeholder, and the real expression lives in an ACAD_FIELD dictionary
;;; hanging off it - referring to other objects by an internal index that only
;;; makes sense within that one object's data, and split across multiple DXF
;;; entries when longer than 250 characters.
;;;
;;; So the expression must be reassembled from its fragments and every internal
;;; reference resolved into a real object ID before it can be written anywhere
;;; else. Copy the raw string without doing that and the destination shows
;;; #### or resolves against the wrong object entirely.
;;;
;;;   FIELDGRAFT  - copy a field expression to other objects
;;; ---------------------------------------------------------------------------

(vl-load-com)

;; Object types that can carry a field.
(setq FieldGraft:Types "TEXT,MTEXT,ATTRIB,MULTILEADER,*DIMENSION")

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

;; ---------------------------------------------------------------------------
;; FieldGraft:ObjectID
;; ---------------------------------------------------------------------------
;; Returns an object's ID as a string. On 64-bit AutoCAD the value exceeds an
;; AutoLISP integer, so GetObjectIdString is used where available. The test is
;; performed once and this function then replaces itself.
;; ---------------------------------------------------------------------------
(defun FieldGraft:ObjectID ( obj )
    (eval
        (list 'defun 'FieldGraft:ObjectID '( obj )
            (if (and (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                     (vlax-method-applicable-p
                         (vla-get-utility (FieldGraft:Doc)) 'getobjectidstring
                     )
                )
                (list 'vla-getobjectidstring
                      (vla-get-utility (FieldGraft:Doc)) 'obj ':vlax-false
                )
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (FieldGraft:ObjectID obj)
)

;; ---------------------------------------------------------------------------
;; FieldGraft:Code
;; ---------------------------------------------------------------------------
;; Returns the fully resolved field expression held by an entity, or nil.
;;
;; Three nested helpers:
;;
;;   FieldGraft:Assemble  - stitches the expression back together from its DXF group 3
;;               fragments, with the final remainder in group 2. AutoCAD splits
;;               any string over 250 characters this way.
;;
;;   FieldGraft:SwapObjs  - replaces each internal "ObjIdx" reference with the real object
;;               ID taken from the matching DXF 331 entry.
;;
;;   FieldGraft:SwapFlds  - resolves nested fields, flagged "\_FldIdx" and stored in their
;;               own dictionaries via DXF 360, by recursing into each.
;;
;; Both swap helpers advance through the entity data as they go - the
;; (cdr (member ent enx)) argument - so repeated references consume successive
;; DXF entries instead of all resolving to the first.
;; ---------------------------------------------------------------------------
(defun FieldGraft:Code ( ent / FieldGraft:SwapFlds FieldGraft:SwapObjs FieldGraft:Assemble enx )

    (defun FieldGraft:Assemble ( enx / itm )
        (if (setq itm (assoc 3 enx))
            (strcat (cdr itm) (FieldGraft:Assemble (cdr (member itm enx))))
            (cond ((cdr (assoc 2 enx))) (""))
        )
    )

    (defun FieldGraft:SwapObjs ( str enx / ent pos )
        (if (setq pos (vl-string-search "ObjIdx" str))
            (strcat
                (substr str 1 (+ pos 5)) " "
                (FieldGraft:ObjectID
                    (vlax-ename->vla-object (cdr (setq ent (assoc 331 enx))))
                )
                (FieldGraft:SwapObjs (substr str (1+ (vl-string-search ">%" str pos)))
                          (cdr (member ent enx))
                )
            )
            str
        )
    )

    (defun FieldGraft:SwapFlds ( str enx / ent fld pos )
        (if (setq pos (vl-string-search "\\_FldIdx" (setq str (FieldGraft:SwapObjs str enx))))
            (progn
                (setq ent (assoc 360 enx)
                      fld (entget (cdr ent))
                )
                (strcat
                    (substr str 1 pos)
                    (FieldGraft:SwapFlds (FieldGraft:Assemble fld) fld)
                    (FieldGraft:SwapFlds (substr str (1+ (vl-string-search ">%" str pos)))
                              (cdr (member ent enx))
                    )
                )
            )
            str
        )
    )

    (if (and (wcmatch (cdr (assoc 0 (setq enx (entget ent)))) FieldGraft:Types)
             (setq enx (cdr (assoc 360 enx)))
             (setq enx (dictsearch enx "ACAD_FIELD"))
             (setq enx (dictsearch (cdr (assoc -1 enx)) "TEXT"))
        )
        (FieldGraft:SwapFlds (FieldGraft:Assemble enx) enx)
    )
)

;; ---------------------------------------------------------------------------
;; FieldGraft:Select
;; ---------------------------------------------------------------------------
;; Repeatedly prompts until fun returns a non-nil result for a validly typed
;; object, or the user presses Enter.
;;
;; Sharing one prompt loop between the source and destination phases keeps the
;; type validation and the "missed, try again" handling in a single place -
;; only the action performed on a good pick differs between the two.
;;
;; msg - [str] prompt to display
;; fun - [function] applied to each valid entity; a non-nil return ends the loop
;; ---------------------------------------------------------------------------
(defun FieldGraft:Select ( msg fun / ent rtn )
    (while
        (progn
            (setvar 'errno 0)
            (setq ent (nentsel msg))
            (cond
                ;; errno 7 means the click missed everything.
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (= 'list (type ent))
                    (cond
                        (   (progn
                                ;; A four-element return means the object is
                                ;; nested; the entity is then the last element
                                ;; of the last element.
                                (if (= 4 (length ent))
                                    (setq ent (last (last ent)))
                                    (setq ent (car ent))
                                )
                                (not (wcmatch (cdr (assoc 0 (entget ent))) FieldGraft:Types))
                            )
                            (princ "\nThat object type cannot hold a field.")
                        )
                        (   (not (setq rtn ((eval fun) ent))))
                    )
                )
            )
        )
    )
    rtn
)

;; ---------------------------------------------------------------------------
;; c:FIELDGRAFT  -  main routine
;; ---------------------------------------------------------------------------
(defun c:FIELDGRAFT ( / *error* vars vals src count )

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

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

    (setvar "CMDECHO" 0)
    (setq count 0)

    (if (setq src
            (FieldGraft:Select "\nSelect the source field: "
                (function
                    (lambda ( ent )
                        (cond ((FieldGraft:Code ent))
                              ((not (princ "\nThat object does not contain a field.")))
                        )
                    )
                )
            )
        )
        (progn
            ;; 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")

            ;; The destination handler always returns nil, which keeps the
            ;; prompt loop running until the user presses Enter - so any number
            ;; of destinations can be filled from one source.
            (FieldGraft:Select "\nSelect destination object <exit>: "
                (function
                    (lambda ( ent / obj )
                        (cond
                            ;; A locked layer would refuse the write, so this is
                            ;; reported plainly rather than failing silently.
                            (   (null (vlax-write-enabled-p
                                          (setq obj (vlax-ename->vla-object ent))
                                      )
                                )
                                (princ "\nThat object is on a locked layer.")
                            )

                            ;; Dimensions carry their text in TextOverride;
                            ;; everything else uses TextString. The write-access
                            ;; test picks whichever this object actually offers.
                            (   (vlax-property-available-p obj 'textoverride t)
                                (vla-put-textoverride obj src)
                                (command "_.updatefield" ent "")
                                (setq count (1+ count))
                                nil
                            )
                            (   (vlax-property-available-p obj 'textstring t)
                                (vla-put-textstring obj src)
                                (command "_.updatefield" ent "")
                                (setq count (1+ count))
                                nil
                            )
                        )
                        nil
                    )
                )
            )

            (princ (strcat "\nField copied to " (itoa count)
                           " object" (if (= 1 count) "" "s") "."
                   )
            )
        )
        (princ "\n*Cancelled* - no source field selected.")
    )

    (FieldGraft:Restore)
    (princ)
)

(princ)