;;; ---------------------------------------------------------------------------
;;; Corral.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Selects everything inside a picked polyline or circle.
;;;
;;; AutoCAD gives you window and crossing selection, but both are rectangles.
;;; When the boundary you care about is an irregular site outline, a room, a
;;; zone or a circle, you are reduced to a fence or a lot of shift-clicking.
;;; This traces the boundary you point at and builds a WPolygon from it.
;;;
;;; TWO WAYS TO USE IT
;;;   1. Type CORRAL at the command line. The objects inside the boundary are
;;;      selected and gripped, ready for the next command.
;;;   2. Type 'CORRAL transparently at any "Select objects:" prompt. The
;;;      enclosed objects are fed straight into the command already running -
;;;      so ERASE, COPY, MOVE and so on can all use it as a selection method.
;;;
;;; The CMDACTIVE test is what distinguishes the two: if no command is running
;;; the routine starts its own SELECT to collect the objects, otherwise it
;;; feeds points into the selection prompt already waiting.
;;;
;;; A NOTE ON UNDO
;;; This routine only selects; it never modifies the drawing. It therefore
;;; deliberately does NOT open an undo group. Doing so would push an empty
;;; entry onto the undo stack, and worse, would corrupt the undo record of the
;;; host command when used transparently.
;;;
;;; COMMAND:  CORRAL  ('CORRAL transparently)  - select inside a boundary
;;; ---------------------------------------------------------------------------

;; ---------------------------------------------------------------------------
;; Number of segments used to approximate a circular boundary. A circle has no
;; vertices to trace, so it is walked as 90 equal steps of 4 degrees. That is
;; well inside drawing tolerance for any realistic radius while keeping the
;; point list short enough for the selection to stay responsive.
;; ---------------------------------------------------------------------------
(setq Corral:Segments 90
      Corral:Step     (/ (* 2.0 pi) 90.0)
)

;; ---------------------------------------------------------------------------
;; c:CORRAL  -  main routine
;; ---------------------------------------------------------------------------
(defun c:CORRAL ( / *error* vars vals pick data etype centre radius idx pt standalone )

    ;; -----------------------------------------------------------------------
    ;; OSMODE is forced to ignore running snaps while the boundary points are
    ;; fed in. Without this, a running snap can drag a traced point onto some
    ;; nearby geometry and distort the selection polygon.
    ;; -----------------------------------------------------------------------
    (setq vars '("CMDECHO" "OSMODE")
          vals (mapcar 'getvar vars)
    )

    ;; The error handler below issues a bare (command) to close a half-finished
    ;; SELECT. AutoCAD 2015 and later refuse ANY (command) call inside an *error*
    ;; handler - the bare cancelling form included - unless the routine declares
    ;; beforehand that it will use one.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())

    ;; -----------------------------------------------------------------------
    ;; No undo group is opened by this routine, so none is closed here - see
    ;; the note in the header.
    ;; -----------------------------------------------------------------------
    (defun Corral:Restore ( )
        ;; Paired with the push above, so the declaration does not outlive the
        ;; command that made it.
        (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        (mapcar 'setvar vars vals)
        (princ)
    )

    (defun *error* ( msg )
        ;; If we died mid-selection there may be a command still waiting for
        ;; input; a bare "" closes it so the user is not left stranded inside
        ;; a half-finished SELECT.
        (if (< 0 (getvar "CMDACTIVE"))
            (command)
        )
        (Corral:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** CORRAL error: " msg " **"))
        )
        (princ)
    )

    (setvar "CMDECHO" 0)

    ;; -----------------------------------------------------------------------
    ;; Pick the boundary. The filter is applied after the pick rather than by
    ;; ssget so that picking the wrong sort of object gives a clear message
    ;; instead of an unexplained non-response.
    ;; -----------------------------------------------------------------------
    (if (setq pick (entsel "\nPick a bounding polyline or circle: "))
        (progn
            (setq data  (entget (car pick))
                  etype (cdr (assoc 0 data))
            )

            (if (member etype '("CIRCLE" "LWPOLYLINE" "POLYLINE"))
                (progn
                    ;; -------------------------------------------------------
                    ;; Suppress running object snaps by setting bit 16384 of
                    ;; OSMODE, which is the "snaps off" flag.
                    ;; -------------------------------------------------------
                    (setvar "OSMODE" (boole 7 (getvar "OSMODE") 16384))

                    ;; -------------------------------------------------------
                    ;; If nothing is running, start our own SELECT so there is
                    ;; a selection prompt to feed the polygon into. standalone
                    ;; records that we did so, because in that case we also
                    ;; have to close the command and grip the result ourselves.
                    ;; -------------------------------------------------------
                    (if (zerop (getvar "CMDACTIVE"))
                        (progn (setq standalone t)
                               (command "_.select")
                        )
                    )

                    ;; "_WP" is window-polygon: everything wholly inside the
                    ;; point list that follows. Change to "_CP" if you would
                    ;; rather also catch objects crossing the boundary.
                    (command "_WP")

                    (if (= "CIRCLE" etype)

                        ;; ---------------------------------------------------
                        ;; Circle: walk the circumference in equal steps.
                        ;; ---------------------------------------------------
                        (progn
                            (setq centre (cdr (assoc 10 data))
                                  radius (cdr (assoc 40 data))
                                  idx    0
                            )
                            (repeat Corral:Segments
                                (setq pt  (polar centre (* idx Corral:Step) radius)
                                      idx (1+ idx)
                                )
                                ;; trans from WCS (0) to the current UCS (1),
                                ;; because the command prompt expects points in
                                ;; user coordinates while entget returns world.
                                (command (trans pt 0 1))
                            )
                        )

                        ;; ---------------------------------------------------
                        ;; Polyline: every DXF group 10 in the entity data is
                        ;; a vertex, so they are fed through in order.
                        ;; ---------------------------------------------------
                        (foreach group data
                            (if (= 10 (car group))
                                (command (trans (cdr group) 0 1))
                            )
                        )
                    )

                    ;; Blank entry terminates the point list.
                    (command "")

                    ;; -------------------------------------------------------
                    ;; When run standalone, close SELECT and grip the result so
                    ;; the user can see and use what was caught. "_P" is the
                    ;; previous selection set, i.e. what SELECT just gathered.
                    ;; -------------------------------------------------------
                    (if standalone
                        (progn
                            (command "")
                            (sssetfirst nil (ssget "_P"))
                        )
                    )
                )
                (princ (strcat "\nA " etype " is not a usable boundary - pick a polyline or circle."))
            )
        )
        (princ "\n*Cancelled* - no boundary picked.")
    )

    (Corral:Restore)
    (princ)
)

(princ)
