;;; ---------------------------------------------------------------------------
;;; ViewFrame.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Draws, IN MODEL SPACE, the outline of what a paper space viewport is
;;; showing.
;;;
;;; This answers the question "what part of the model does this sheet actually
;;; cover?" without opening the viewport and guessing. Run it across a whole
;;; drawing set and you get a key plan: a rectangle in model space for every
;;; sheet, showing its extent.
;;;
;;; COMMANDS
;;;   VIEWFRAME        - outline one selected viewport
;;;   VIEWFRAMELAYOUT  - outline every viewport on the current layout
;;;   VIEWFRAMEALL     - outline every viewport on every layout
;;;
;;; Rectangular, polygonal and clipped viewports are all handled, including
;;; clip boundaries containing arc segments.
;;;
;;; CONFIGURABLE - see the settings block below
;;;   ViewFrame:Offset      draws the outline set in from the true edge by a
;;;                         number of PAPER space units, which is useful when
;;;                         the sheet border overlaps the viewport edge
;;;   ViewFrame:Properties  layer, colour, linetype and so on for the outline
;;;
;;; HOW THE TRANSFORMATION WORKS
;;; A viewport's boundary is defined in paper space, but the outline must be
;;; drawn in model space. Converting between the two means undoing everything
;;; the viewport does to the view it shows: its zoom scale, its twist angle,
;;; its view direction and the offset between its centre and the model point it
;;; is centred on. That is what ViewFrame:ToModel computes.
;;; ---------------------------------------------------------------------------

(vl-load-com)

;;; ---------------------------------------------------------------------------
;;; SETTINGS
;;; ---------------------------------------------------------------------------

;; Interior offset, in PAPER space units. nil or 0.0 for none.
(setq ViewFrame:Offset 0.0)

;; Properties applied to the outline. Comment a line out to leave that property
;; at the drawing's current setting. The layer line is supplied commented, as in
;; the original - uncomment it to put outlines on their own layer, which will be
;; created automatically.
(setq ViewFrame:Properties
   '(
        (006 . "BYLAYER")   ; linetype - must already be loaded
       ;(008 . "VPOutline") ; layer - created automatically if uncommented
        (039 . 0.0)         ; thickness
        (048 . 1.0)         ; linetype scale
        (062 . 256)         ; colour: 0 = BYBLOCK, 256 = BYLAYER
        (370 . -1)          ; lineweight: -1 BYLAYER, -2 BYBLOCK, -3 default
    )
)

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

;;; ---------------------------------------------------------------------------
;;; MATRIX AND VECTOR HELPERS - namespaced, since the originals were bare
;;; globals named trp, mxm, mxv and vxs.
;;; ---------------------------------------------------------------------------

(defun ViewFrame:Transpose ( m )
    (apply 'mapcar (cons 'list m))
)

(defun ViewFrame:MxV ( m v )
    (mapcar (function (lambda ( row ) (apply '+ (mapcar '* row v)))) m)
)

(defun ViewFrame:MxM ( m n )
    (   (lambda ( a ) (mapcar (function (lambda ( row ) (ViewFrame:MxV a row))) m))
        (ViewFrame:Transpose n)
    )
)

(defun ViewFrame:Scale ( v s )
    (mapcar (function (lambda ( n ) (* n s))) v)
)

;; ---------------------------------------------------------------------------
;; ViewFrame:Clockwise
;; ---------------------------------------------------------------------------
;; True if a point list runs clockwise.
;;
;; This is the shoelace formula: summing the cross products of consecutive
;; point pairs gives twice the signed area, whose sign indicates the direction
;; of travel.
;;
;; It matters because offsetting a polyline inward or outward depends on which
;; way round it goes - so a boundary running the wrong way has to be reversed
;; before the offset is applied, or the outline would be set OUT rather than in.
;; ---------------------------------------------------------------------------
(defun ViewFrame:Clockwise ( lst )
    (minusp
        (apply '+
            (mapcar
                (function
                    (lambda ( a b )
                        (- (* (car b) (cadr a)) (* (car a) (cadr b)))
                    )
                )
                lst (cons (last lst) lst)
            )
        )
    )
)

;; ---------------------------------------------------------------------------
;; ViewFrame:Vertices
;; ---------------------------------------------------------------------------
;; Returns a polyline's vertices as ((point . bulgePair) ...), handling both
;; light and heavy polylines.
;;
;; A clipped viewport's boundary can be either type. In an LWPOLYLINE the
;; vertices are repeated groups within one entity; in a heavy POLYLINE they are
;; separate VERTEX sub-entities following the header. The two branches walk
;; each accordingly.
;;
;; Rewritten as two plainly named recursive helpers. The original achieved the
;; same with a pair of anonymous lambdas that called themselves by a name they
;; were only bound to at the moment of application - correct, but very hard to
;; follow.
;; ---------------------------------------------------------------------------
(defun ViewFrame:Vertices ( ent / ViewFrame:WalkLight ViewFrame:WalkHeavy )

    ;; LWPOLYLINE: step forward through the repeated group 10 entries.
    (defun ViewFrame:WalkLight ( enx )
        (if (setq enx (member (assoc 10 enx) enx))
            (cons (cons (cdr (assoc 10 enx)) (assoc 42 enx))
                  (ViewFrame:WalkLight (cdr enx))
            )
        )
    )

    ;; Heavy POLYLINE: step forward through the VERTEX sub-entities.
    (defun ViewFrame:WalkHeavy ( ent / enx )
        (if (= "VERTEX" (cdr (assoc 0 (setq enx (entget ent)))))
            (cons (cons (cdr (assoc 10 enx)) (assoc 42 enx))
                  (ViewFrame:WalkHeavy (entnext ent))
            )
        )
    )

    (if (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
        (ViewFrame:WalkLight (entget ent))
        (ViewFrame:WalkHeavy (entnext ent))
    )
)

;; ---------------------------------------------------------------------------
;; ViewFrame:ToModel
;; ---------------------------------------------------------------------------
;; Converts a point from the viewport's own coordinate space into world
;; coordinates - the transformation the whole routine depends on.
;;
;; The viewport's relevant DXF groups:
;;   10  centre of the viewport, in paper space
;;   12  the model point the view is centred on
;;   16  view direction, which gives the model plane
;;   17  view target point
;;   41  viewport width in paper space
;;   45  view height in model units
;;   51  twist angle
;;
;; The scale factor is the model height divided by the paper width, which is
;; the zoom of the view. The matrix combines the view direction with the twist
;; angle, negated because the boundary is being mapped BACK out of the twisted
;; view rather than into it.
;;
;; Reading the arithmetic: scale the point, subtract the scaled viewport centre
;; so the result is relative to the centre rather than to the paper origin, add
;; the model centre, rotate, and finally translate onto the view target.
;;
;; pnt - [list] point in the viewport's paper space
;; ent - [ename] the viewport entity
;; ---------------------------------------------------------------------------
(defun ViewFrame:ToModel ( pnt ent / ang enx mat nor scl )
    (setq pnt (trans pnt 0 0)
          enx (entget ent)
          ang (- (cdr (assoc 51 enx)))
          nor (cdr (assoc 16 enx))
          scl (/ (cdr (assoc 45 enx)) (cdr (assoc 41 enx)))
          mat (ViewFrame:MxM
                  (mapcar (function (lambda ( v ) (trans v 0 nor t)))
                         '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
                  )
                  (list (list (cos ang) (- (sin ang)) 0.0)
                        (list (sin ang)    (cos ang)  0.0)
                       '(0.0 0.0 1.0)
                  )
              )
    )
    (mapcar '+
        (ViewFrame:MxV mat
            (mapcar '+
                (ViewFrame:Scale pnt scl)
                (ViewFrame:Scale (cdr (assoc 10 enx)) (- scl))
                (cdr (assoc 12 enx))
            )
        )
        (cdr (assoc 17 enx))
    )
)

;; ---------------------------------------------------------------------------
;; ViewFrame:Outline
;; ---------------------------------------------------------------------------
;; Creates the model space outline for one viewport.
;;
;; vpt - [ename] the viewport entity
;; ---------------------------------------------------------------------------
(defun ViewFrame:Outline ( vpt / cen ent lst ltp ocs ofe off tmp vpe props )

    (setq off ViewFrame:Offset)

    ;; -----------------------------------------------------------------------
    ;; Obtain the boundary. DXF 340 points at a clip boundary if the viewport
    ;; has one; without it the viewport is a plain rectangle and its corners
    ;; are built from the centre (10) plus half the width (40) and height (41).
    ;;
    ;; The four operator pairs generate the corners anticlockwise from the
    ;; bottom-left: (- -), (+ -), (+ +), (- +).
    ;; -----------------------------------------------------------------------
    (if (setq vpt (entget vpt)
              ent (cdr (assoc 340 vpt))
        )
        (setq lst (ViewFrame:Vertices ent))
        (setq cen (mapcar 'list (cdr (assoc 10 vpt))
                      (list (/ (cdr (assoc 40 vpt)) 2.0)
                            (/ (cdr (assoc 41 vpt)) 2.0)
                      )
                  )
              lst (mapcar (function (lambda ( a ) (cons (mapcar 'apply a cen) '(42 . 0.0))))
                         '((- -) (+ -) (+ +) (- +))
                  )
        )
    )

    ;; Force anticlockwise, so the offset below goes inward. Reversing a
    ;; polyline also requires negating every bulge and shifting them one vertex,
    ;; since a bulge describes the segment LEAVING its vertex.
    (if (not (ViewFrame:Clockwise (mapcar 'car lst)))
        (setq lst
            (reverse
                (mapcar (function (lambda ( a b ) (cons (car a) (cons 42 (- (cddr b))))))
                        lst (cons (last lst) lst)
                )
            )
        )
    )

    ;; -----------------------------------------------------------------------
    ;; Apply the interior offset, if one is configured.
    ;;
    ;; A temporary polyline is built in paper space terms, offset by AutoCAD's
    ;; own engine, and its vertices taken - which handles arc segments in a
    ;; clip boundary correctly. Both temporaries are then removed.
    ;;
    ;; A viewport too small to offset by the requested amount is reported and
    ;; left un-offset rather than failing.
    ;; -----------------------------------------------------------------------
    (if (and (numberp off) (not (equal 0.0 off 1e-8)))
        (cond
            (   (null (setq tmp
                          (entmakex
                              (append
                                  (list '(000 . "LWPOLYLINE")
                                        '(100 . "AcDbEntity")
                                        '(100 . "AcDbPolyline")
                                         (cons 90 (length lst))
                                        '(070 . 1)
                                  )
                                  (apply 'append
                                      (mapcar (function (lambda ( x ) (list (cons 10 (car x)) (cdr x)))) lst)
                                  )
                              )
                          )
                      )
                )
                (princ "\nCould not build the outline for offsetting.")
            )

            (   (vl-catch-all-error-p
                    (setq ofe (vl-catch-all-apply 'vlax-invoke
                                  (list (vlax-ename->vla-object tmp) 'offset off)
                              )
                    )
                )
                (princ (strcat "\nViewport too small to offset by " (rtos off) " units - outline drawn at full size."))
                (entdel tmp)
            )

            (   (setq ofe (vlax-vla-object->ename (car ofe))
                      lst (ViewFrame:Vertices ofe)
                )
                (entdel ofe)
                (entdel tmp)
            )
        )
    )

    (setq vpe (cdr (assoc -1 vpt))
          ocs (cdr (assoc 16 vpt))
    )

    ;; A linetype that is not loaded would make entmakex fail silently, so it
    ;; is checked and downgraded to BYLAYER with a warning.
    (setq props
        (if (and (setq ltp (assoc 6 ViewFrame:Properties))
                 (not (tblsearch "ltype" (cdr ltp)))
            )
            (progn
                (princ (strcat "\nLinetype \"" (cdr ltp) "\" is not loaded - using BYLAYER."))
                (subst '(6 . "BYLAYER") ltp ViewFrame:Properties)
            )
            ViewFrame:Properties
        )
    )

    ;; Group 410 forces the polyline into model space regardless of where the
    ;; command was run from.
    (entmakex
        (append
            (list '(000 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                   (cons 90 (length lst))
                  '(070 . 1)
                  '(410 . "Model")
            )
            props
            (apply 'append
                (mapcar
                    (function
                        (lambda ( x )
                            (list (cons 10 (trans (ViewFrame:ToModel (car x) vpe) 0 ocs))
                                  (cdr x)
                            )
                        )
                    )
                    lst
                )
            )
            (list (cons 210 ocs))
        )
    )
)

;; ---------------------------------------------------------------------------
;; ViewFrame:Restore
;; ---------------------------------------------------------------------------
(defun ViewFrame:Restore ( vars vals )
    (mapcar 'setvar vars vals)
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (command "_.UNDO" "_End")
        (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
    )
    (princ)
)

;; ---------------------------------------------------------------------------
;; ViewFrame:Ssget
;; ---------------------------------------------------------------------------
(defun ViewFrame: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)
)

;; ---------------------------------------------------------------------------
;; c:VIEWFRAME  -  outline one selected viewport
;; ---------------------------------------------------------------------------
(defun c:VIEWFRAME ( / *error* vars vals sel )

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

    (defun *error* ( msg )
        (ViewFrame:Restore vars vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** VIEWFRAME error: " msg " **"))
        )
        (princ)
    )

    (setvar "CMDECHO" 0)
    ;; 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")

    (cond
        (   (/= 1 (getvar 'cvport))
            (princ "\nThis command is only available in paper space.")
        )
        (   (setq sel (ViewFrame:Ssget "\nSelect a viewport: " '("_+.:E:S" ((0 . "VIEWPORT")))))
            (ViewFrame:Outline (ssname sel 0))
            (princ "\nViewport outline created in model space.")
        )
        (   t
            (princ "\nNo viewport selected.")
        )
    )

    (ViewFrame:Restore vars vals)
    (princ)
)

;; ---------------------------------------------------------------------------
;; c:VIEWFRAMELAYOUT  -  outline every viewport on the current layout
;; ---------------------------------------------------------------------------
;; The (-4 . "<>") (69 . 1) clause excludes viewport number 1, which is the
;; paper space "viewport" representing the sheet itself rather than a window
;; onto the model.
;; ---------------------------------------------------------------------------
(defun c:VIEWFRAMELAYOUT ( / *error* vars vals idx sel )

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

    (defun *error* ( msg )
        (ViewFrame:Restore vars vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** VIEWFRAMELAYOUT error: " msg " **"))
        )
        (princ)
    )

    (setvar "CMDECHO" 0)

    (cond
        (   (/= 1 (getvar 'cvport))
            (princ "\nThis command is only available in paper space.")
        )
        (   (setq sel (ssget "_X" (list '(0 . "VIEWPORT") '(-4 . "<>") '(69 . 1)
                                        (cons 410 (getvar 'ctab)))))
            ;; 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")
            (repeat (setq idx (sslength sel))
                (ViewFrame:Outline (ssname sel (setq idx (1- idx))))
            )
            (princ (strcat "\n" (itoa (sslength sel))
                           " viewport" (if (= 1 (sslength sel)) "" "s") " outlined."
                   )
            )
        )
        (   t
            (princ "\nNo viewports found on the current layout.")
        )
    )

    (ViewFrame:Restore vars vals)
    (princ)
)

;; ---------------------------------------------------------------------------
;; c:VIEWFRAMEALL  -  outline every viewport on every layout
;; ---------------------------------------------------------------------------
;; The (410 . "~Model") clause matches every space EXCEPT model space, the
;; tilde being a negation wildcard.
;; ---------------------------------------------------------------------------
(defun c:VIEWFRAMEALL ( / *error* vars vals idx sel )

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

    (defun *error* ( msg )
        (ViewFrame:Restore vars vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** VIEWFRAMEALL error: " msg " **"))
        )
        (princ)
    )

    (setvar "CMDECHO" 0)

    (cond
        (   (setq sel (ssget "_X" '((0 . "VIEWPORT") (-4 . "<>") (69 . 1) (410 . "~Model"))))
            ;; 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")
            (repeat (setq idx (sslength sel))
                (ViewFrame:Outline (ssname sel (setq idx (1- idx))))
            )
            (princ (strcat "\n" (itoa (sslength sel))
                           " viewport" (if (= 1 (sslength sel)) "" "s")
                           " outlined across all layouts."
                   )
            )
        )
        (   t
            (princ "\nNo viewports found on any layout.")
        )
    )

    (ViewFrame:Restore vars vals)
    (princ)
)

(princ)