;;; ---------------------------------------------------------------------------
;;; FreezeFrame.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Pins individual objects so they cannot be modified, and keeps them pinned
;;; between drawing sessions.
;;;
;;; COMMANDS
;;;   PINOBJECT    - pin selected objects
;;;   UNPINOBJECT  - release selected objects
;;;   UNPINALL     - release everything and remove the stored record
;;;
;;; READ THIS BEFORE RELYING ON IT
;;; This is a demonstration of what reactors can do, not a security feature.
;;; The protection only works while this file is loaded - anyone who opens the
;;; drawing without it can edit the objects freely. For genuinely locking
;;; content, a locked LAYER does the same job, is enforced by AutoCAD itself,
;;; and travels with the drawing.
;;;
;;; Where it IS useful is protecting a survey base, a grid or a title block
;;; from your own accidental edits during a working session.
;;;
;;; HOW IT WORKS
;;; Two reactors, plus a dictionary:
;;;
;;;   Editor reactor  - fires after every command and every LISP routine
;;;                     finishes. It compares each pinned object against the
;;;                     DXF data captured when it was pinned and writes that
;;;                     data back, undoing any change. If an object was
;;;                     deleted, it is undeleted.
;;;
;;;   Drawing reactor - fires on save, writing the pinned objects' handles into
;;;                     a drawing dictionary so the pins can be rebuilt when
;;;                     the drawing is next opened with this file loaded.
;;;
;;; Note the consequence of the first: changes are not PREVENTED, they are
;;; REVERSED immediately after the command that made them. The object flickers
;;; rather than refusing to move.
;;; ---------------------------------------------------------------------------

(vl-load-com)

;;; ---------------------------------------------------------------------------
;;; A NOTE ON THE GLOBALS BELOW
;;;
;;; These cannot be localised. The reactor callbacks fire long after the
;;; commands that created them have returned, so their state must persist at
;;; global scope.
;;;
;;;   *FreezeFrame:Handles*  the handles of every pinned object
;;;   *FreezeFrame:Data*     each pinned object's DXF data as captured at the
;;;                          moment of pinning - this is the master copy that
;;;                          any modification is reverted back to
;;; ---------------------------------------------------------------------------
(or *FreezeFrame:Handles* (setq *FreezeFrame:Handles* nil))
(or *FreezeFrame:Data*    (setq *FreezeFrame:Data*    nil))

;; Dictionary name used to persist the pins in the drawing.
(setq FreezeFrame:DictName "FreezeFrame")

;; ---------------------------------------------------------------------------
;; FreezeFrame:GetItem
;; ---------------------------------------------------------------------------
;; Returns a named item from a COM collection, or nil if absent.
;;
;; The catch is essential: asking a collection for something it does not hold
;; throws rather than returning nil.
;; ---------------------------------------------------------------------------
(defun FreezeFrame:GetItem ( collection item )
    (if (not (vl-catch-all-error-p
                 (setq item (vl-catch-all-apply 'vla-item (list collection item)))
             )
        )
        item
    )
)

;; ---------------------------------------------------------------------------
;; FreezeFrame:RemoveReactors
;; ---------------------------------------------------------------------------
;; Removes every reactor belonging to this routine.
;;
;; Reactors are identified by their data tag rather than by a stored handle, so
;; that reactors left behind by a previous load of this file are also found -
;; otherwise repeatedly loading it would stack duplicates.
;; ---------------------------------------------------------------------------
(defun FreezeFrame:RemoveReactors ( / r )
    (foreach r (apply 'append (mapcar 'cdr (vlr-reactors)))
        (if (= FreezeFrame:DictName (vlr-data r))
            (vlr-remove r)
        )
    )
    (princ)
)

;; ---------------------------------------------------------------------------
;; FreezeFrame:Revert  -  editor reactor callback
;; ---------------------------------------------------------------------------
;; Restores every pinned object to its captured state.
;;
;; The entget/entdel pair is the trick that undeletes: calling entdel on an
;; entity that has ALREADY been deleted restores it. So asking for its data
;; first, and only calling entdel when that returns nil, means a deleted object
;; comes back and a surviving one is left alone.
;;
;; entmod then writes the captured DXF data back over whatever the object now
;; holds, reversing any other modification.
;; ---------------------------------------------------------------------------
(defun FreezeFrame:Revert ( reactor args )
    (mapcar
        (function
            (lambda ( h )
                (or (entget (handent h)) (entdel (handent h)))
            )
        )
        *FreezeFrame:Handles*
    )
    (mapcar 'entmod *FreezeFrame:Data*)
    (princ)
)

;; ---------------------------------------------------------------------------
;; FreezeFrame:Save  -  drawing reactor callback
;; ---------------------------------------------------------------------------
;; Writes the pinned handles into a drawing dictionary so they survive the
;; drawing being closed and reopened.
;;
;; The xrecord takes two parallel safearrays: the DXF group codes, and the
;; values. Group 1 is the code for a string, so a list of 1s of the right
;; length is built to match the handle list.
;; ---------------------------------------------------------------------------
(defun FreezeFrame:Save ( reactor args / dicts dict xrec codes )
    (if *FreezeFrame:Handles*
        (progn
            (setq dicts (vla-get-dictionaries
                            (vla-get-activedocument (vlax-get-acad-object))
                        )
            )
            (if (not (setq dict (FreezeFrame:GetItem dicts FreezeFrame:DictName)))
                (setq dict (vla-add dicts FreezeFrame:DictName))
            )
            (if (not (setq xrec (FreezeFrame:GetItem dict "Handles")))
                (setq xrec (vla-addxrecord dict "Handles"))
            )

            (repeat (length *FreezeFrame:Handles*)
                (setq codes (cons 1 codes))
            )

            (vla-setxrecorddata xrec
                (vlax-safearray-fill
                    (vlax-make-safearray vlax-vbinteger
                        (cons 0 (1- (length *FreezeFrame:Handles*)))
                    )
                    codes
                )
                (vlax-safearray-fill
                    (vlax-make-safearray vlax-vbvariant
                        (cons 0 (1- (length *FreezeFrame:Handles*)))
                    )
                    (mapcar (function (lambda ( h ) (vlax-make-variant h vlax-vbstring)))
                            *FreezeFrame:Handles*
                    )
                )
            )
        )
    )
    (princ)
)

;; ---------------------------------------------------------------------------
;; FreezeFrame:Arm
;; ---------------------------------------------------------------------------
;; Creates the two reactors if they are not already present.
;; ---------------------------------------------------------------------------
(defun FreezeFrame:Arm ( )
    (if (not (vl-some (function (lambda ( r ) (= FreezeFrame:DictName (vlr-data r))))
                      (cdar (vlr-reactors :vlr-editor-reactor))
             )
        )
        (vlr-editor-reactor FreezeFrame:DictName
            (list (cons :vlr-commandEnded 'FreezeFrame:Revert)
                  (cons :vlr-lispEnded    'FreezeFrame:Revert)
            )
        )
    )
    (if (not (vl-some (function (lambda ( r ) (= FreezeFrame:DictName (vlr-data r))))
                      (cdar (vlr-reactors :vlr-dwg-reactor))
             )
        )
        (vlr-dwg-reactor FreezeFrame:DictName
            (list (cons :vlr-beginSave 'FreezeFrame:Save))
        )
    )
    (princ)
)

;; ---------------------------------------------------------------------------
;; c:PINOBJECT  -  pin selected objects
;; ---------------------------------------------------------------------------
;; No undo group is opened: pinning changes nothing in the drawing, it only
;; records state. There is nothing to undo.
;; ---------------------------------------------------------------------------
(defun c:PINOBJECT ( / *error* sel idx added handle data )

    (defun *error* ( msg )
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** PINOBJECT error: " msg " **"))
        )
        (princ)
    )

    (if (setq sel (ssget))
        (progn
            (setq added 0)
            (repeat (setq idx (sslength sel))
                (setq data   (entget (ssname sel (setq idx (1- idx))))
                      handle (cdr (assoc 5 data))
                )
                ;; Already-pinned objects are skipped, so re-pinning a
                ;; selection cannot store a second, newer copy of its data -
                ;; which would defeat the point by baking in a change.
                (if (not (member handle *FreezeFrame:Handles*))
                    (setq *FreezeFrame:Handles* (cons handle *FreezeFrame:Handles*)
                          *FreezeFrame:Data*    (cons data   *FreezeFrame:Data*)
                          added                 (1+ added)
                    )
                )
            )
            (FreezeFrame:Arm)
            (princ (strcat "\n" (itoa added)
                           " object" (if (= 1 added) "" "s") " pinned. "
                           (itoa (length *FreezeFrame:Handles*)) " pinned in total."
                   )
            )
        )
        (princ "\nNothing selected.")
    )

    (princ)
)

;; ---------------------------------------------------------------------------
;; c:UNPINOBJECT  -  release selected objects
;; ---------------------------------------------------------------------------
;; Note that the original left two of its variables undeclared, leaking them
;; globally on every run. All are localised here.
;; ---------------------------------------------------------------------------
(defun c:UNPINOBJECT ( / *error* sel idx removed handle data )

    (defun *error* ( msg )
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** UNPINOBJECT error: " msg " **"))
        )
        (princ)
    )

    (if *FreezeFrame:Handles*
        (if (setq sel (ssget))
            (progn
                (setq removed 0)
                (repeat (setq idx (sslength sel))
                    (setq data   (entget (ssname sel (setq idx (1- idx))))
                          handle (cdr (assoc 5 data))
                    )
                    (if (member handle *FreezeFrame:Handles*)
                        (setq *FreezeFrame:Handles* (vl-remove handle *FreezeFrame:Handles*)
                              *FreezeFrame:Data*    (vl-remove data   *FreezeFrame:Data*)
                              removed               (1+ removed)
                        )
                    )
                )
                (princ (strcat "\n" (itoa removed)
                               " object" (if (= 1 removed) "" "s") " released. "
                               (itoa (length *FreezeFrame:Handles*)) " still pinned."
                       )
                )
            )
            (princ "\nNothing selected.")
        )
        (princ "\nNo objects are currently pinned.")
    )

    ;; With nothing left pinned, the reactors have no work to do and are
    ;; removed rather than left running on every command.
    (if (null *FreezeFrame:Handles*)
        (FreezeFrame:RemoveReactors)
    )

    (princ)
)

;; ---------------------------------------------------------------------------
;; c:UNPINALL  -  release everything
;; ---------------------------------------------------------------------------
;; Also deletes the drawing dictionary, so the pins do not return the next time
;; the drawing is opened.
;; ---------------------------------------------------------------------------
(defun c:UNPINALL ( / *error* dicts dict count )

    (defun *error* ( msg )
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** UNPINALL error: " msg " **"))
        )
        (princ)
    )

    (setq count (length *FreezeFrame:Handles*))

    (FreezeFrame:RemoveReactors)

    (setq dicts (vla-get-dictionaries
                    (vla-get-activedocument (vlax-get-acad-object))
                )
    )
    (if (setq dict (FreezeFrame:GetItem dicts FreezeFrame:DictName))
        (vla-delete dict)
    )

    (setq *FreezeFrame:Handles* nil
          *FreezeFrame:Data*    nil
    )

    (princ (strcat "\nAll pins removed (" (itoa count)
                   " object" (if (= 1 count) "" "s") " released)."
           )
    )
    (princ)
)

;; ---------------------------------------------------------------------------
;; LOAD-TIME RESTORE
;; ---------------------------------------------------------------------------
;; Rebuilds the pins from the drawing dictionary, if one is present.
;;
;; Handles are filtered through entget first, discarding any whose object no
;; longer exists - a drawing edited without this file loaded may well have had
;; pinned objects genuinely deleted, and trying to revert a handle that resolves
;; to nothing would throw on every subsequent command.
;; ---------------------------------------------------------------------------
(   (lambda ( / dict xrec typ val )

        ;; Clear anything left over from a previous load.
        (FreezeFrame:RemoveReactors)

        (if (and (setq dict
                     (FreezeFrame:GetItem
                         (vla-get-dictionaries
                             (vla-get-activedocument (vlax-get-acad-object))
                         )
                         FreezeFrame:DictName
                     )
                 )
                 (setq xrec (FreezeFrame:GetItem dict "Handles"))
                 (progn (vla-getxrecorddata xrec 'typ 'val) val)
            )
            (if (and (setq *FreezeFrame:Handles*
                         (vl-remove-if-not
                             (function (lambda ( h ) (entget (handent h))))
                             (mapcar 'vlax-variant-value (vlax-safearray->list val))
                         )
                     )
                     (setq *FreezeFrame:Data*
                         (mapcar (function (lambda ( h ) (entget (handent h))))
                                 *FreezeFrame:Handles*
                         )
                     )
                )
                (progn
                    (FreezeFrame:Arm)
                    (princ (strcat "\nFreezeFrame: "
                                   (itoa (length *FreezeFrame:Handles*))
                                   " pinned object"
                                   (if (= 1 (length *FreezeFrame:Handles*)) "" "s")
                                   " restored."
                           )
                    )
                )
            )
        )
    )
)

(princ)