;;; ---------------------------------------------------------------------------
;;; SheetEcho.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Copies objects to the SAME POSITION on other paper space layouts.
;;;
;;; The use case is anything that has to appear identically on every sheet: a
;;; revision cloud, a north point, a preliminary stamp, a client logo, a
;;; standard note block. Draw it once on one sheet and echo it to the rest,
;;; landing at identical coordinates on each.
;;;
;;; COMMANDS
;;;   SHEETECHO     - choose target layouts from a list
;;;   SHEETECHOALL  - copy to every other layout, no dialog
;;;
;;; PAPER SPACE ONLY - AND WHY
;;; Both commands refuse to run in model space. Model space is a single shared
;;; space, not one of a series of sheets, so "copy to all layouts" has no
;;; sensible meaning from there. The source layout is also excluded from its
;;; own target list, since copying objects onto themselves would just produce
;;; duplicates stacked exactly on the originals.
;;;
;;; The copy is done through the ActiveX CopyObjects method rather than by
;;; COPYCLIP and PASTECLIP, which means the clipboard is never touched and
;;; coordinates transfer exactly - no rounding, no paste offset.
;;;
;;; The dialog is written out at run time and deleted immediately after use, so
;;; this remains a single self-contained file with no companion .dcl to deploy.
;;; ---------------------------------------------------------------------------

(vl-load-com)

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

;; ---------------------------------------------------------------------------
;; SheetEcho:ListBox
;; ---------------------------------------------------------------------------
;; Displays a multi-select list and returns the chosen strings, or nil if the
;; user cancelled.
;;
;; The dialog name "sheetecho" must match between the DCL text written here and
;; the new_dialog call below - if you rename one, rename both.
;;
;; msg - [str] dialog title
;; lst - [list] strings to display
;; ---------------------------------------------------------------------------
(defun SheetEcho:ListBox ( msg lst / dch des tmp rtn )
    (cond
        (   (not
                (and
                    (setq tmp (vl-filename-mktemp nil nil ".dcl"))
                    (setq des (open tmp "w"))
                    (write-line
                        (strcat
                            "sheetecho:dialog{label=\"" msg "\";spacer;"
                            ":list_box{key=\"list\";multiple_select=true;width=50;height=15;}"
                            "spacer;ok_cancel;}"
                        )
                        des
                    )
                    (not (close des))
                    (< 0 (setq dch (load_dialog tmp)))
                    (new_dialog "sheetecho" dch)
                )
            )
            (princ "\nThe layout selection dialog could not be created.")
        )
        (   t
            (start_list "list")
            (foreach itm lst (add_list itm))
            (end_list)

            ;; Pre-select the first entry so OK is never meaningless.
            (setq rtn (set_tile "list" "0"))
            (action_tile "list" "(setq rtn $value)")

            ;; A multi-select list returns space-separated indices as a string,
            ;; e.g. "0 3 4". Bracketing and reading it yields a list of
            ;; integers, which are then mapped back to the layout names.
            (setq rtn
                (if (= 1 (start_dialog))
                    (mapcar (function (lambda ( n ) (nth n lst)))
                            (read (strcat "(" rtn ")"))
                    )
                )
            )
        )
    )

    ;; Cleanup on every path, cancelled or not.
    (if (and dch (< 0 dch))
        (unload_dialog dch)
    )
    (if (and tmp (setq tmp (findfile tmp)))
        (vl-file-delete tmp)
    )
    rtn
)

;; ---------------------------------------------------------------------------
;; SheetEcho:Run
;; ---------------------------------------------------------------------------
;; Shared implementation for both commands.
;;
;; all - [boolean] T to copy to every layout without prompting
;; ---------------------------------------------------------------------------
(defun SheetEcho:Run ( all / *error* vars vals current layouts objects sel targets )

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

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

    (setvar "CMDECHO" 0)
    (setq current (strcase (getvar 'ctab)))

    (cond
        ;; CVPORT of 1 means paper space is active.
        (   (/= 1 (getvar 'cvport))
            (princ "\nThis command is only available in paper space.")
        )

        (   (not (cdr (layoutlist)))
            (princ "\nThis drawing has only one layout - there is nowhere to copy to.")
        )

        ;; The (410 . current) filter confines the selection to the active
        ;; layout, so a stray window cannot pick up objects from elsewhere.
        (   (not (ssget (list (cons 410 current))))
            (princ "\nNothing selected.")
        )

        (   (progn
                ;; Build the candidate list, excluding model space and the
                ;; layout we are copying FROM.
                (vlax-for lyt (vla-get-layouts (SheetEcho:Doc))
                    (cond
                        (   (= :vlax-true (vla-get-modeltype lyt)))
                        (   (= current (strcase (vla-get-name lyt))))
                        (   (setq layouts (cons (cons (vla-get-name lyt) lyt) layouts)))
                    )
                )

                (or
                    ;; SHEETECHOALL: take every candidate.
                    (and all (setq targets (mapcar 'cdr layouts)))

                    ;; SHEETECHO: offer them in tab order, which is the order
                    ;; the user sees along the bottom of the screen, then map
                    ;; the chosen names back to their layout objects.
                    (setq targets
                        (mapcar (function (lambda ( name ) (cdr (assoc name layouts))))
                            (SheetEcho:ListBox "Select Target Layouts"
                                (mapcar 'car
                                    (vl-sort layouts
                                        (function
                                            (lambda ( a b )
                                                (< (vla-get-taborder (cdr a))
                                                   (vla-get-taborder (cdr b))
                                                )
                                            )
                                        )
                                    )
                                )
                            )
                        )
                    )
                )
            )

            ;; Convert the pickset into a list of VLA-objects, which is what
            ;; CopyObjects requires.
            (vlax-for obj (setq sel (vla-get-activeselectionset (SheetEcho:Doc)))
                (setq objects (cons obj objects))
            )
            ;; ActiveX selection sets persist in the document until deleted.
            (vla-delete sel)

            ;; 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")

            ;; One CopyObjects call per target layout, into that layout's own
            ;; block - which is what places the copies at identical coordinates
            ;; rather than at a paste point.
            (foreach lay targets
                (vlax-invoke (SheetEcho:Doc) 'copyobjects objects (vla-get-block lay))
            )

            (princ
                (strcat "\n" (itoa (length objects))
                        " object" (if (cdr objects) "s" "")
                        " copied to " (itoa (length targets))
                        " layout" (if (cdr targets) "s" "") "."
                )
            )
        )

        (   t
            (princ "\n*Cancelled* - no target layouts chosen.")
        )
    )

    (SheetEcho:Restore)
    (princ)
)

;; ---------------------------------------------------------------------------
;; Command wrappers
;; ---------------------------------------------------------------------------
(defun c:SHEETECHO    nil (SheetEcho:Run nil))   ; choose target layouts
(defun c:SHEETECHOALL nil (SheetEcho:Run   t))   ; copy to every layout

(princ)