;;; ---------------------------------------------------------------------------
;;; ClipBox.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; CLIP A DRAWING TO A RECTANGLE
;;;
;;; PURPOSE
;;;   Window a rectangle and everything outside it disappears - anything that
;;;   crosses the edge is trimmed off cleanly at the boundary rather than left
;;;   hanging. Or do the reverse, and punch the rectangle out of the drawing.
;;;
;;;   This is what you want when lifting a detail out of a large plan, cutting a
;;;   supplied drawing down to the bit you actually need, or clearing a hole for
;;;   something new. Doing it by hand means a window erase, then trimming a
;;;   dozen stragglers one at a time.
;;;
;;;   CLIPKEEP  keeps what is inside the rectangle
;;;   CLIPWIPE  removes what is inside the rectangle
;;;   CLIPBOX   asks which, and whether to leave the boundary drawn
;;;
;;; HOW IT WORKS
;;;   A closed polyline is built on the rectangle and used as the cutting edge
;;;   for TRIM. Everything wholly on the unwanted side is erased outright; only
;;;   what straddles the boundary needs trimming, and the boundary itself does
;;;   the cutting.
;;;
;;;   The trim runs as four separate fence lines, one per side, rather than one
;;;   fence round the whole rectangle. That is not tidiness - a fence that turns
;;;   a corner behaves unpredictably at the corner itself, and four straight
;;;   passes are reliable where one folded pass is not. That was in the original
;;;   and it was the right call.
;;;
;;; THE ONE THING THAT MATTERS ON A MODERN AUTOCAD
;;;   From AutoCAD 2021, TRIM defaults to Quick mode, which does NOT ask which
;;;   objects to use as cutting edges - it works everything out for itself. Any
;;;   older routine that feeds TRIM a cutting edge and then a fence, as this one
;;;   does, has its answers read as something else entirely and either fails or
;;;   trims the wrong things.
;;;
;;;   The fix is TRIMEXTENDMODE, set to 0 for Standard behaviour while the
;;;   routine runs and put back afterwards. It is read through a guard because
;;;   the variable does not exist before 2021, and asking for a system variable
;;;   that is not there is itself an error.
;;;
;;; WHAT ELSE WAS FIXED
;;;   - The error handler never ran. NEWERR was defined at the top level but
;;;     also listed as a local of the function that installed it, so at the
;;;     moment of (setq *error* newerr) the local was still nil and the error
;;;     handler was set to nothing at all. Cancelling half way left CMDECHO and
;;;     HIGHLIGHT changed and a stray boundary polyline in the drawing.
;;;   - SCB, SC and SCD were defined INSIDE the CUT command, so none of them
;;;     existed until CUT had been run once. Typing SCB in a fresh drawing gave
;;;     "unknown command".
;;;   - The dialog called (exit) on cancel, which raises an error rather than
;;;     returning, leaving the dialog loaded and its handle leaked.
;;;   - Erasing used ALL then removed a crossing window. ALL includes objects on
;;;     locked layers, and erasing those fails and stops the routine. Locked
;;;     layers are now reported and skipped.
;;;   - The boundary was drawn with the PLINE command, so a running object snap
;;;     could pull a corner to a nearby object and clip the wrong rectangle.
;;;   - No undo group, so putting it back took one U per internal operation.
;;;
;;;   CLIPBOX   - clip to a rectangle, asking what to keep
;;;   CLIPKEEP  - keep what is inside
;;;   CLIPWIPE  - remove what is inside
;;; ---------------------------------------------------------------------------

;;; ---------------------------------------------------------------------------
;;; SUPPORT
;;; ---------------------------------------------------------------------------

;;; Read a system variable that may not exist on this release. Returns nil
;;; rather than raising an error.
(defun ClipBox:SafeGet ( name / r )
    (setq r (vl-catch-all-apply 'getvar (list name)))
    (if (vl-catch-all-error-p r) nil r)
)

(defun ClipBox:SafeSet ( name value )
    (vl-catch-all-apply 'setvar (list name value))
    (princ)
)

;;; The four corners of the rectangle two picked points describe, in order,
;;; whichever way round they were picked.
(defun ClipBox:Corners ( p1 p2 / x1 x2 y1 y2 )
    (setq x1 (min (car p1) (car p2)) x2 (max (car p1) (car p2))
          y1 (min (cadr p1) (cadr p2)) y2 (max (cadr p1) (cadr p2)))
    (list (list x1 y1) (list x2 y1) (list x2 y2) (list x1 y2))
)

;;; Names of every locked layer. Objects on these cannot be erased or trimmed,
;;; and finding out the hard way means stopping half finished.
(defun ClipBox:LockedLayers ( / lay out )
    (while (setq lay (tblnext "LAYER" (null lay)))
        (if (= 4 (logand 4 (cdr (assoc 70 lay))))
            (setq out (cons (cdr (assoc 2 lay)) out))))
    out
)

;;; A closed polyline on the four corners, made directly rather than by running
;;; PLINE, so no object snap can interfere with it.
(defun ClipBox:Boundary ( pts layer )
    (entmake (append
        (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 layer)
              '(100 . "AcDbPolyline") (cons 90 (length pts)) '(70 . 1))
        (mapcar '(lambda ( p ) (cons 10 (list (car p) (cadr p)))) pts)))
    (entlast)
)

;;; Everything in the current layout, less whatever the crossing window catches.
;;; Used to find what lies wholly outside the rectangle.
(defun ClipBox:Outside ( p1 p2 / all cross i e out )
    (setq all   (ssget "_X" (list (cons 410 (getvar "CTAB"))))
          cross (ssget "_C" p1 p2)
          out   (ssadd)
          i     0)
    (if all
        (while (< i (sslength all))
            (setq e (ssname all i))
            (if (or (null cross) (null (ssmemb e cross))) (ssadd e out))
            (setq i (1+ i))))
    (if (> (sslength out) 0) out)
)

;;; ---------------------------------------------------------------------------
;;; THE WORK
;;;
;;; KEEPINSIDE t  - keep what is inside, clear everything else
;;; KEEPINSIDE nil - clear what is inside, keep everything else
;;; BORDER      t  - leave the boundary polyline behind
;;; ---------------------------------------------------------------------------

(defun ClipBox:Run ( keepInside border / p1 p2 pts bound ss locked
                                          fence off c1 c2 c3 c4 )

    (setq p1 (getpoint "\nFirst corner of the rectangle: "))
    (if p1 (setq p2 (getcorner p1 "\nOpposite corner: ")))

    (if (or (null p1) (null p2))
        (princ "\nCancelled.")
        (progn
            (setq locked (ClipBox:LockedLayers))
            (if locked
                (princ (strcat "\n  Note: " (itoa (length locked))
                               " locked layer"
                               (if (= 1 (length locked)) " is" "s are")
                               " in this drawing and will be left alone.")))

            (setq pts   (ClipBox:Corners p1 p2)
                  c1    (nth 0 pts) c2 (nth 1 pts)
                  c3    (nth 2 pts) c4 (nth 3 pts)
                  bound (ClipBox:Boundary pts (getvar "CLAYER")))

            ;; --- clear the unwanted side ---------------------------------
            (if keepInside
                ;; Everything wholly outside goes, except the boundary itself.
                (progn
                    (setq ss (ClipBox:Outside c1 c3))
                    (if ss (ssdel bound ss))
                    (if (and ss (> (sslength ss) 0))
                        (command "_.ERASE" ss "")))
                ;; Everything wholly inside goes. A window - not a crossing
                ;; window - so objects straddling the edge survive to be
                ;; trimmed.
                (progn
                    (setq ss (ssget "_W" c1 c3))
                    (if ss (ssdel bound ss))
                    (if (and ss (> (sslength ss) 0))
                        (command "_.ERASE" ss ""))))

            ;; --- trim what straddles the boundary -------------------------
            ;; The fence runs just to the side of each edge that is being
            ;; cleared, so it catches the stubs and not the part being kept.
            (setq off (/ (distance c1 c3) 1000.0))
            (if (<= off 0.0) (setq off 1e-6))
            (setq fence (if keepInside off (- off)))

            (setq ss (ssadd bound (ssadd)))

            (command "_.TRIM" ss ""
                "_F" (list (- (car c1) fence) (- (cadr c1) fence))
                     (list (+ (car c2) fence) (- (cadr c2) fence)) ""
                "_F" (list (+ (car c2) fence) (- (cadr c2) fence))
                     (list (+ (car c3) fence) (+ (cadr c3) fence)) ""
                "_F" (list (+ (car c3) fence) (+ (cadr c3) fence))
                     (list (- (car c4) fence) (+ (cadr c4) fence)) ""
                "_F" (list (- (car c4) fence) (+ (cadr c4) fence))
                     (list (- (car c1) fence) (- (cadr c1) fence)) ""
                "")

            ;; --- the boundary itself --------------------------------------
            (if (and bound (not border) (entget bound)) (entdel bound))

            (princ (strcat "\nClipped. The rectangle was "
                           (rtos (abs (- (car c3) (car c1))) 2 3) " by "
                           (rtos (abs (- (cadr c3) (cadr c1))) 2 3) "."))
        )
    )
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; COMMANDS
;;;
;;; All three share one front end, which is what sets up and puts back the
;;; drawing environment. The work itself is above.
;;; ---------------------------------------------------------------------------

(defun ClipBox:Wrap ( keepInside border / *error* vars vals trimmode )

    (setq vars '("CMDECHO" "HIGHLIGHT" "OSMODE" "BLIPMODE")
          vals (mapcar 'getvar vars))

    ;; Saved and restored out here rather than around the TRIM itself, so that
    ;; an error or a cancel in the middle cannot leave TRIM stuck in Standard
    ;; mode for the rest of the session.
    (setq trimmode (ClipBox:SafeGet "TRIMEXTENDMODE"))

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

    (setvar "CMDECHO" 0)
    (setvar "HIGHLIGHT" 0)
    (setvar "BLIPMODE" 0)
    (setvar "OSMODE" 0)
    ;; AutoCAD 2015 and later refuse (command) inside an *error* handler unless
    ;; the routine says up front that it will use one.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")
    (if trimmode (ClipBox:SafeSet "TRIMEXTENDMODE" 0))

    (ClipBox:Run keepInside border)

    (ClipBox:Restore)
    (princ)
)

(defun c:CLIPKEEP ( ) (ClipBox:Wrap t nil))
(defun c:CLIPWIPE ( ) (ClipBox:Wrap nil nil))

(defun c:CLIPBOX ( / keep border )
    (initget "Keep Wipe")
    (setq keep (/= "Wipe" (getkword
        "\nRectangle contents [Keep/Wipe] <Keep>: ")))
    (initget "Yes No")
    (setq border (= "Yes" (getkword
        "\nLeave the boundary drawn [Yes/No] <No>: ")))
    (ClipBox:Wrap keep border)
)

(princ)