;;; ---------------------------------------------------------------------------
;;; XrefRevert.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Resets xref layer overrides back to whatever the SOURCE drawing says.
;;;
;;; When you attach an xref, its layers appear in your drawing as
;;; "XREFNAME|LayerName" and you can change their colour, linetype, visibility
;;; and so on locally. Those local changes override the source. Over a long job
;;; that accumulates until nobody can remember which properties are the
;;; consultant's and which are somebody's local fiddling.
;;;
;;; This reads the properties straight out of the source drawing file and
;;; writes them back over the local overrides.
;;;
;;; OPTIONS AT THE PROMPT
;;;   pick an xref  - reset that one
;;;   Multiple      - window-select several
;;;   All           - every xref in the drawing
;;;   Settings      - choose WHICH properties get reset
;;;
;;; The Settings dialog covers colour, linetype, lineweight, plot, plot style,
;;; frozen-in-viewport, on, locked, frozen and description. Your choice is
;;; remembered between sessions, so you can reset colour alone and leave your
;;; own visibility settings intact.
;;;
;;; HOW THE SOURCE IS READ
;;; The source drawing is opened through ObjectDBX, which reads a DWG without
;;; opening it in the editor - so this works across dozens of xrefs in seconds
;;; and without disturbing the drawing you are in.
;;;
;;; If an xref is ALREADY open in this AutoCAD session, the live document is
;;; used instead. That matters because ObjectDBX cannot open a file that is
;;; locked by the editor, and it also means unsaved changes in that drawing are
;;; picked up.
;;;
;;; If the source cannot be found at its recorded path, the support file search
;;; path is tried before giving up.
;;;
;;;   XREFREVERT  - reset xref layer overrides from source
;;; ---------------------------------------------------------------------------

(vl-load-com)

;; Environment key for the remembered property selection.
(setq XrefRevert:Key "YZ\\XrefRevertProps")

;; ---------------------------------------------------------------------------
;; The resettable layer properties, in bit order. The position of each in this
;; list determines its bit value: 1, 2, 4, 8 and so on.
;; ---------------------------------------------------------------------------
(setq XrefRevert:Properties
   '(
        truecolor          ; 1    - handles true colour and colour book colours
        linetype           ; 2
        lineweight         ; 4
        plottable          ; 8
        plotstylename      ; 16
        viewportdefault    ; 32   - frozen in new viewports
        layeron            ; 64
        lock               ; 128
        freeze             ; 256
        description        ; 512
    )
)

;; The matching dialog tile keys, in the same order.
(setq XrefRevert:Tiles
   '("colour" "linetype" "lineweight" "plot" "plotstyle"
     "frozenvp" "on" "locked" "frozen" "description")
)

;; All ten bits set - used to detect and drive the Select All toggle.
(setq XrefRevert:AllBits 1023)

;; ---------------------------------------------------------------------------
;; XrefRevert:Doc  /  XrefRevert:App  -  cached COM objects
;; ---------------------------------------------------------------------------
(defun XrefRevert:Doc nil
    (eval (list 'defun 'XrefRevert:Doc 'nil
                (vla-get-activedocument (vlax-get-acad-object))
          )
    )
    (XrefRevert:Doc)
)

(defun XrefRevert:App nil
    (eval (list 'defun 'XrefRevert:App 'nil (vlax-get-acad-object)))
    (XrefRevert:App)
)

;; ---------------------------------------------------------------------------
;; XrefRevert:Ssget
;; ---------------------------------------------------------------------------
;; ssget with a custom prompt, restoring NOMUTT to its captured value.
;; ---------------------------------------------------------------------------
(defun XrefRevert:Ssget ( msg arg / mutt sel )
    (princ msg)
    (setq mutt (getvar 'nomutt))
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt mutt)
    (if (not (vl-catch-all-error-p sel)) sel)
)

;; ---------------------------------------------------------------------------
;; XrefRevert:Settings
;; ---------------------------------------------------------------------------
;; Displays the property selection dialog and returns the chosen bit code.
;;
;; Each toggle owns one bit. Its action expression flips that bit in the
;; working value with boole mode 6, which is exclusive-OR - so ticking sets it
;; and unticking clears it - and then updates the Select All toggle to match.
;;
;; The dialog name "xrefrevert" must agree between the DCL text and new_dialog.
;;
;; Note that the original left its tile-name list undeclared, leaking it into
;; the global namespace; it is localised here.
;;
;; code - [int] the currently selected bit code
;; ---------------------------------------------------------------------------
(defun XrefRevert:Settings ( code / bit dch dcl tmp tiles )
    (cond
        (   (not
                (and
                    (setq dcl (vl-filename-mktemp nil nil ".dcl"))
                    (setq tmp (open dcl "w"))
                    (progn
                        (foreach line
                           '(
                                "xrefrevert : dialog { label = \"Properties to Reset\"; spacer;"
                                "    : boxed_column { label = \"Reset from source drawing\"; width = 65.0; fixed_width = true; alignment = centered; spacer;"
                                "        : row { alignment = centered; spacer; "
                                "            : column {"
                                "                : toggle { key = \"colour\";     label = \"Colour\"; }"
                                "                : toggle { key = \"linetype\";   label = \"Linetype\"; }"
                                "                : toggle { key = \"lineweight\"; label = \"Lineweight\"; }"
                                "            }"
                                "            : column {"
                                "                : toggle { key = \"plot\";      label = \"Plot\"; }"
                                "                : toggle { key = \"plotstyle\"; label = \"Plot Style\"; }"
                                "                : toggle { key = \"frozenvp\";  label = \"Frozen in VP\"; }"
                                "            }"
                                "            : column {"
                                "                : toggle { key = \"on\";     label = \"On\"; }"
                                "                : toggle { key = \"locked\"; label = \"Locked\"; }"
                                "                : toggle { key = \"frozen\"; label = \"Frozen\"; }"
                                "            }"
                                "            : column {"
                                "                : toggle { key = \"description\"; label = \"Description\"; }"
                                "                spacer;"
                                "                : toggle { key = \"selectall\";   label = \"Select All\"; }"
                                "            }"
                                "        }"
                                "        spacer;"
                                "    }"
                                "    spacer; ok_cancel;"
                                "}"
                            )
                            (write-line line tmp)
                        )
                        (setq tmp (close tmp))
                        ;; Wait for the file system to catch up - load_dialog on
                        ;; a file not yet flushed to disk fails intermittently.
                        (while (null (findfile dcl)))
                        (< 0 (setq dch (load_dialog dcl)))
                    )
                    (new_dialog "xrefrevert" dch)
                )
            )
            (princ "\nThe settings dialog could not be created.")
        )

        (   t
            (setq bit   1
                  tmp   code
                  tiles XrefRevert:Tiles
            )
            (if (= XrefRevert:AllBits tmp)
                (set_tile "selectall" "1")
            )

            ;; Set each toggle from its bit, and attach the flip action.
            (foreach tile tiles
                (if (= bit (logand tmp bit))
                    (set_tile tile "1")
                    (set_tile tile "0")
                )
                (action_tile tile
                    (strcat "(setq tmp (boole 6 tmp " (itoa bit) "))"
                            "(set_tile \"selectall\" (if (= " (itoa XrefRevert:AllBits) " tmp) \"1\" \"0\")))"
                    )
                )
                (setq bit (lsh bit 1))
            )

            (action_tile "selectall"
                (strcat "(foreach tile tiles (set_tile tile $value))"
                        "(if (= \"1\" $value)"
                        "    (setq tmp " (itoa XrefRevert:AllBits) ")"
                        "    (setq tmp 0)"
                        ")"
                )
            )

            (if (= 1 (start_dialog))
                (setq code tmp)
            )
        )
    )

    (if (and dch (< 0 dch)) (unload_dialog dch))
    (if (and (= 'str (type dcl)) (setq dcl (findfile dcl))) (vl-file-delete dcl))
    code
)

;; ---------------------------------------------------------------------------
;; XrefRevert:SourceDocument
;; ---------------------------------------------------------------------------
;; Returns a document object for the xref's source drawing, or nil.
;;
;; Three cases, in order of preference:
;;   1. The drawing is already OPEN in this session - use that document, since
;;      ObjectDBX cannot open a file the editor has locked, and this also picks
;;      up unsaved changes.
;;   2. Open it through ObjectDBX, which reads the file without loading it into
;;      the editor.
;;   3. Report failure.
;;
;; The path is taken from the block record's DXF group 1. If it does not
;; resolve, the bare filename is tried through findfile, which searches the
;; support file search path - covering the common case of an xref recorded with
;; an absolute path from another machine.
;;
;; dbx - [vla-object] the reusable ObjectDBX document
;; dcs - [list] (uppercaseFullName . document) for every open drawing
;; xrf - [str] xref block name
;; ---------------------------------------------------------------------------
(defun XrefRevert:SourceDocument ( dbx dcs xrf / err pat xrp )
    (setq xrp (cdr (assoc 1 (entget (tblobjname "block" xrf)))))
    (cond
        (   (not (or (setq pat (findfile xrp))
                     (setq pat (findfile (strcat (vl-filename-base xrp) ".dwg")))
                 )
            )
            (princ (strcat "\n  - source drawing for \"" xrf "\" not found."))
            nil
        )
        (   (cdr (assoc (strcase pat) dcs)))
        (   (not (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vla-open (list dbx pat)))))
            dbx
        )
        (   (princ (strcat "\n  - could not open the source for \"" xrf "\": "
                           (vl-catch-all-error-message err)
                   )
            )
            nil
        )
    )
)

;; ---------------------------------------------------------------------------
;; XrefRevert:ReadLayers
;; ---------------------------------------------------------------------------
;; Reads the requested properties of every layer in a document, returning
;;
;;     ((LAYERNAME (bit . value) (bit . value) ...) ...)
;;
;; Only the properties whose bits are set in flg are read, so unticking a
;; property in the settings dialog genuinely skips the work rather than merely
;; discarding the result.
;; ---------------------------------------------------------------------------
(defun XrefRevert:ReadLayers ( doc flg / bit dat lst )
    (vlax-for lay (vla-get-layers doc)
        (setq bit 1
              lst nil
        )
        (foreach prp XrefRevert:Properties
            (if (and (vlax-property-available-p lay prp)
                     (= bit (logand bit flg))
                )
                (setq lst (cons (cons bit (vlax-get-property lay prp)) lst))
            )
            (setq bit (lsh bit 1))
        )
        (setq dat (cons (cons (strcase (vla-get-name lay)) (reverse lst)) dat))
    )
    dat
)

;; ---------------------------------------------------------------------------
;; XrefRevert:Reset
;; ---------------------------------------------------------------------------
;; Resets one xref's dependent layers from its source. Returns T on success.
;;
;; The xref is RELOADED first, which reconciles the layer list with the source
;; - otherwise a layer added or removed in the source since the last reload
;; would not be found.
;;
;; Local layer names take the form "XREFNAME|LayerName", so the part after the
;; pipe is matched against the source's layer names.
;;
;; THE LINETYPE SPECIAL CASE
;; Linetype (bit 2) is the one property whose VALUE must also be qualified:
;; the source's "DASHED" exists locally as "XREFNAME|DASHED". Continuous is the
;; exception, since it is never xref-qualified - which is why it is tested for
;; explicitly.
;;
;; Each write is caught individually: a locked layer, or a linetype not loaded
;; in this drawing, should cost that one property rather than the whole reset.
;; ---------------------------------------------------------------------------
(defun XrefRevert:Reset ( xrf xrd doc flg / ass bit dat def lyn pos val count )
    (cond
        (   (null xrd) nil)

        (   (vl-catch-all-error-p
                (setq def (vl-catch-all-apply 'vla-item (list (vla-get-blocks doc) xrf)))
            )
            (princ (strcat "\n  - \"" xrf "\" is not present in this drawing."))
            nil
        )

        (   (setq dat (XrefRevert:ReadLayers xrd flg))
            (vla-reload def)
            (setq count 0)

            (vlax-for lay (vla-get-layers doc)
                (setq lyn (strcase (vla-get-name lay))
                      bit 1
                )
                (if (and (setq pos (vl-string-position 124 lyn))     ; 124 is "|"
                         (= (strcase xrf) (substr lyn 1 pos))
                         (setq ass (cdr (assoc (substr lyn (+ 2 pos)) dat)))
                    )
                    (progn
                        (foreach prp XrefRevert:Properties
                            (if (and (vlax-property-available-p lay prp t)   ; t = writable
                                     (= bit (logand bit flg))
                                     (setq val (cdr (assoc bit ass)))
                                )
                                (if (and (= 2 bit) (/= "continuous" (strcase val t)))
                                    (vl-catch-all-apply 'vlax-put-property
                                        (list lay prp (strcat xrf "|" val))
                                    )
                                    (vl-catch-all-apply 'vlax-put-property (list lay prp val))
                                )
                            )
                            (setq bit (lsh bit 1))
                        )
                        (setq count (1+ count))
                    )
                )
            )
            (princ (strcat "\n  + \"" xrf "\": " (itoa count)
                           " layer" (if (= 1 count) "" "s") " reset."
                   )
            )
            t
        )
    )
)

;; ---------------------------------------------------------------------------
;; c:XREFREVERT  -  main routine
;; ---------------------------------------------------------------------------
(defun c:XREFREVERT ( / *error* vars vals bit dbx def idx lst sel tmp xrf dcs )

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

    (defun XrefRevert:Restore ( )
        ;; The ObjectDBX object must be released however the routine exits, or
        ;; it persists in memory for the rest of the AutoCAD session.
        (if (and (= 'vla-object (type dbx)) (not (vlax-object-released-p dbx)))
            (vlax-release-object dbx)
        )
        (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 )
        (XrefRevert:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** XREFREVERT error: " msg " **"))
        )
        (princ)
    )

    (setvar "CMDECHO" 0)

    ;; Recover the remembered property selection, defaulting to colour,
    ;; linetype, lineweight, plot and freeze.
    (if (null (setq bit (getenv XrefRevert:Key)))
        (setq bit (+ 1 2 4 8 512))
        (setq bit (atoi bit))
    )

    ;; Build a comma-separated wildcard of every xref name, for the Multiple
    ;; option's selection filter. Bit 4 of DXF 70 marks a block as an xref.
    (while (setq def (tblnext "block" (null def)))
        (if (= 4 (logand 4 (cdr (assoc 70 def))))
            (setq lst (cons "," (cons (cdr (assoc 2 def)) lst)))
        )
    )

    (cond
        (   (null lst)
            (princ "\nThis drawing contains no xrefs.")
        )

        ;; The ObjectDBX class name is version-specific from AutoCAD 2004
        ;; (version 16) onward.
        (   (progn
                (setq dbx
                    (vl-catch-all-apply 'vla-getinterfaceobject
                        (list (XrefRevert:App)
                            (if (< (setq tmp (atoi (getvar 'acadver))) 16)
                                "objectdbx.axdbdocument"
                                (strcat "objectdbx.axdbdocument." (itoa tmp))
                            )
                        )
                    )
                )
                (or (null dbx) (vl-catch-all-error-p dbx))
            )
            (princ "\nUnable to interface with ObjectDBX on this AutoCAD version.")
        )

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

            ;; Index every drawing currently open, so an xref already loaded in
            ;; the editor is read from there rather than through ObjectDBX.
            (vlax-for doc (vla-get-documents (XrefRevert:App))
                (setq dcs (cons (cons (strcase (vla-get-fullname doc)) doc) dcs))
            )

            (while
                (progn
                    (setvar 'errno 0)
                    (initget "Multiple All Settings Exit")
                    (setq sel (entsel "\nSelect xref to reset [Multiple/All/Settings] <Exit>: "))
                    (cond
                        (   (= 7 (getvar 'errno))
                            (princ "\nMissed, try again.")
                        )

                        (   (or (= "Exit" sel) (null sel)) nil)

                        (   (= "Multiple" sel)
                            (if (setq sel
                                    (XrefRevert:Ssget "\nSelect xrefs to reset: "
                                        (list (list '(0 . "INSERT")
                                                    (cons 2 (apply 'strcat (cdr lst)))
                                              )
                                        )
                                    )
                                )
                                (repeat (setq idx (sslength sel))
                                    (XrefRevert:Reset
                                        (setq xrf (cdr (assoc 2 (entget (ssname sel (setq idx (1- idx)))))))
                                        (XrefRevert:SourceDocument dbx dcs xrf)
                                        (XrefRevert:Doc)
                                        bit
                                    )
                                )
                            )
                            nil
                        )

                        (   (= "All" sel)
                            ;; The list holds names interleaved with commas, so
                            ;; the separators are skipped.
                            (foreach xrf (cdr lst)
                                (if (/= "," xrf)
                                    (XrefRevert:Reset xrf
                                        (XrefRevert:SourceDocument dbx dcs xrf)
                                        (XrefRevert:Doc)
                                        bit
                                    )
                                )
                            )
                            nil
                        )

                        (   (= "Settings" sel)
                            (setq bit (XrefRevert:Settings bit))
                            t
                        )

                        (   (vl-consp sel)
                            (if (= "INSERT" (cdr (assoc 0 (setq sel (entget (car sel))))))
                                (if (= 4 (logand 4 (cdr (assoc 70 (tblsearch "block" (cdr (assoc 2 sel)))))))
                                    (XrefRevert:Reset
                                        (setq xrf (cdr (assoc 2 sel)))
                                        (XrefRevert:SourceDocument dbx dcs xrf)
                                        (XrefRevert:Doc)
                                        bit
                                    )
                                    (princ "\nThat block is not an xref.")
                                )
                                (princ "\nThat object is not a block.")
                            )
                            t
                        )
                    )
                )
            )

            (vla-regen (XrefRevert:Doc) acallviewports)
        )
    )

    ;; Remember the property selection for next time.
    (setenv XrefRevert:Key (itoa bit))

    (XrefRevert:Restore)
    (princ)
)

(princ)