;;; ---------------------------------------------------------------------------
;;; FenceCut.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; SPLIT EVERYTHING THAT CROSSES A FENCE
;;;
;;; PURPOSE
;;;   Draw a fence across a drawing and every object it crosses is cut at the
;;;   crossing point. Nothing is erased and nothing moves - objects are simply
;;;   split in two where the fence passes through them.
;;;
;;;   This is the operation you want before deleting half a plan, before moving a
;;;   section of a site layout, or before putting a match line through a drawing
;;;   that has to be split across two sheets. TRIM and BREAK both do parts of it,
;;;   but neither will run a line across a drawing and divide everything it meets
;;;   in one pass.
;;;
;;; HOW IT WORKS
;;;   1. The fence is either picked point by point, or taken from a line or
;;;      polyline you have already drawn - useful when the match line is real
;;;      geometry that has to stay.
;;;
;;;   2. A temporary polyline is built along the fence. It exists only to be
;;;      intersected against, and is removed before the command ends.
;;;
;;;   3. Objects are gathered with a FENCE selection, which is AutoCAD's own way
;;;      of asking "what does this line cross" and is far more reliable than
;;;      testing crossing windows segment by segment.
;;;
;;;   4. Each object is intersected against the fence. Intersections are found
;;;      through the object itself rather than by hand, so arcs, ellipses,
;;;      splines and polylines with bulges all work - the routine this replaces
;;;      only handled straight lines, straight polylines and full circles, and
;;;      rebuilt them vertex by vertex.
;;;
;;;   5. Each crossing point is then broken, using the point both to identify
;;;      the object and to place the break. That one trick is what lets a single
;;;      piece of code split every curve type: whatever is under that point gets
;;;      divided there, with no gap.
;;;
;;; CIRCLES ARE A SPECIAL CASE
;;;   A circle has no ends, so there is no such thing as breaking one at a single
;;;   point - the result would still be one object. A circle crossed twice is
;;;   therefore replaced by two arcs spanning between the crossings, which is the
;;;   only sensible reading of "cut this circle in half".
;;;
;;;   A circle the fence only clips once is left alone, and reported.
;;;
;;; WHAT IS PRESERVED
;;;   Layer, colour, linetype and width all come through untouched, because the
;;;   objects are broken rather than deleted and redrawn. The original rebuilt
;;;   polylines from scratch and had to copy those properties across by hand.
;;;
;;;   FENCECUT  - split every object crossing a fence
;;; ---------------------------------------------------------------------------

(vl-load-com)

;;; Cached handle on the active document, resolved once per session.
(defun FenceCut:Doc nil
    (eval (list 'defun 'FenceCut:Doc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (FenceCut:Doc)
)

(defun FenceCut:Space ( )
    (if (= 1 (getvar "CVPORT"))
        (vla-get-paperspace (FenceCut:Doc))
        (vla-get-modelspace (FenceCut:Doc)))
)

;;; ---------------------------------------------------------------------------
;;; GEOMETRY HELPERS
;;; ---------------------------------------------------------------------------

;;; INTERSECTWITH hands back a flat run of doubles - x, y, z, x, y, z - rather
;;; than a list of points, so it has to be regrouped into threes.
(defun FenceCut:Intersections ( a b / res out )
    ;; 0 is acExtendNone - intersections on the objects as drawn, with neither
    ;; extended to meet the other. The numeric value is used rather than the
    ;; named constant because the name is only defined once the ActiveX type
    ;; library has been loaded, which is not guaranteed at load time.
    (setq res (vl-catch-all-apply
                  '(lambda ( ) (vlax-safearray->list
                                   (vlax-variant-value
                                       (vla-IntersectWith a b 0))))))
    (if (or (vl-catch-all-error-p res) (null res))
        nil
        (progn
            (while (>= (length res) 3)
                (setq out (cons (list (car res) (cadr res) (caddr res)) out)
                      res (cdddr res)))
            (reverse out)))
)

;;; Two points close enough to be the same crossing. Breaking twice at what is
;;; really one point leaves a zero-length fragment.
(defun FenceCut:Same ( p q ) (< (distance p q) 1e-8))

(defun FenceCut:Unique ( pts / out )
    (foreach p pts
        (if (not (vl-some '(lambda (q) (FenceCut:Same p q)) out))
            (setq out (cons p out))))
    (reverse out)
)

;;; ---------------------------------------------------------------------------
;;; CUTTING
;;; ---------------------------------------------------------------------------

;;; Break whatever sits under a point, at that point, with no gap.
;;;
;;; Passing the point as BREAK's object selection AND as its first break point,
;;; with "@" as the second, is what makes this work for every curve type at once.
;;; Wrapped because a point that lands on nothing selectable is not worth
;;; aborting the whole run for.
(defun FenceCut:BreakAt ( pt )
    (not (vl-catch-all-error-p
             (vl-catch-all-apply
                 '(lambda ( ) (command "_.BREAK" pt "_F" pt "@")))))
)

;;; A circle crossed twice becomes two arcs. Drawn with ARC's centre option so
;;; both halves share the original centre and radius exactly.
(defun FenceCut:SplitCircle ( ent p1 p2 / dat cen )
    (setq dat (entget ent)
          cen (cdr (assoc 10 dat)))
    ;; Both arcs run anticlockwise between the same two points, so taking them
    ;; in each order gives the two complementary halves.
    (command "_.ARC" "_C" cen p1 p2)
    (command "_.ARC" "_C" cen p2 p1)
    (entdel ent)
    t
)

;;; ---------------------------------------------------------------------------
;;; THE FENCE
;;;
;;; Returns the fence as a list of points, or nil.
;;; ---------------------------------------------------------------------------

(defun FenceCut:GetFence ( / opt sel dat typ pts p n )

    (initget "Pick Select")
    (setq opt (getkword "\nDefine the fence by [Pick/Select an existing line or polyline] <Pick>: "))
    (if (null opt) (setq opt "Pick"))

    (if (= opt "Select")
        (progn
            (setq sel (car (entsel "\nSelect the line or polyline to cut along: ")))
            (if sel
                (progn
                    (setq dat (entget sel) typ (cdr (assoc 0 dat)))
                    (cond
                        ((= typ "LINE")
                         (list (cdr (assoc 10 dat)) (cdr (assoc 11 dat))))
                        ((= typ "LWPOLYLINE")
                         (mapcar 'cdr (vl-remove-if-not
                                          '(lambda (x) (= 10 (car x))) dat)))
                        ((= typ "POLYLINE")
                         ;; A heavy polyline keeps its vertices as separate
                         ;; entities following the header.
                         (setq n (entnext sel) pts nil)
                         (while (and n (= "VERTEX" (cdr (assoc 0 (entget n)))))
                             (setq pts (cons (cdr (assoc 10 (entget n))) pts)
                                   n   (entnext n)))
                         (reverse pts))
                        (t (princ "\nThat is not a line or polyline.") nil)))))

        (progn
            (setq p (getpoint "\nFirst point of the fence: "))
            (if p
                (progn
                    (setq pts (list p))
                    (while (setq p (getpoint (last pts) "\nNext point <Enter to finish>: "))
                        (grdraw (last pts) p -1 1)
                        (setq pts (append pts (list p))))
                    (if (> (length pts) 1) pts
                        (progn (princ "\nA fence needs at least two points.") nil))))))
)

;;; ---------------------------------------------------------------------------
;;; MAIN COMMAND
;;; ---------------------------------------------------------------------------

(defun c:FENCECUT ( / *error* vars vals fence temp tempObj ss i ent obj typ
                      hits cut skipped circles )

    (setq vars '("CMDECHO" "OSMODE" "BLIPMODE" "PEDITACCEPT")
          vals (mapcar 'getvar vars))
    (setq temp nil)

    (defun FenceCut:Cleanup ( )
        ;; The scratch fence polyline must go whatever happens - leaving one
        ;; behind on a drawing looks exactly like a real match line. TEMP is
        ;; cleared immediately afterwards because ENTDEL toggles: calling it a
        ;; second time would bring the polyline back.
        (if temp (vl-catch-all-apply '(lambda ( ) (entdel temp))))
        (setq temp nil)
        (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 )
        (FenceCut:Cleanup)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** FENCECUT 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")
    (setvar "BLIPMODE" 0)

    (if (null (setq fence (FenceCut:GetFence)))
        (princ "\nNo fence - nothing done.")
        (progn
            (setvar "OSMODE" 0)

            ;; Scratch polyline along the fence, purely to intersect against.
            (command "_.PLINE" (car fence) "_W" 0 0)
            (foreach p (cdr fence) (command p))
            (command "")
            (setq temp    (entlast)
                  tempObj (vlax-ename->vla-object temp))

            ;; FENCE selection is AutoCAD's own answer to "what does this cross".
            (setq ss (ssget "_F" fence))

            (if (null ss)
                (princ "\nThe fence does not cross anything.")
                (progn
                    (setq i 0 cut 0 skipped 0 circles 0)
                    (repeat (sslength ss)
                        (setq ent (ssname ss i) i (1+ i))

                        ;; Skip the scratch fence, and the real fence object when
                        ;; one was selected rather than picked.
                        (if (/= ent temp)
                            (progn
                                (setq obj  (vlax-ename->vla-object ent)
                                      typ  (cdr (assoc 0 (entget ent)))
                                      hits (FenceCut:Unique
                                               (FenceCut:Intersections obj tempObj)))

                                (cond
                                    ((null hits) nil)

                                    ;; A circle has no ends to break against.
                                    ((= typ "CIRCLE")
                                     (if (= 2 (length hits))
                                         (progn
                                             (FenceCut:SplitCircle ent (car hits) (cadr hits))
                                             (setq cut (1+ cut)))
                                         (setq circles (1+ circles))))

                                    (t
                                     (foreach p hits
                                         (if (FenceCut:BreakAt p)
                                             (setq cut (1+ cut))
                                             (setq skipped (1+ skipped)))))
                                )
                            )
                        )
                    )

                    (princ (strcat "\n" (itoa cut) " cut(s) made along the fence."))
                    (if (> circles 0)
                        (princ (strcat "\n" (itoa circles)
                                       " circle(s) left alone - a circle needs two"
                                       " crossings to divide into arcs.")))
                    (if (> skipped 0)
                        (princ (strcat "\n" (itoa skipped)
                                       " crossing(s) could not be broken.")))
                )
            )
        )
    )

    (FenceCut:Cleanup)
    (princ)
)

(princ)