;;; ---------------------------------------------------------------------------
;;; BlockNotch.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; TRIM GEOMETRY TO A BLOCK OUTLINE AUTOMATICALLY
;;;
;;; Drop a block onto a line and the line runs straight through it. BlockNotch
;;; cuts the line so the block sits in a clean gap, exactly as a valve sits in
;;; a pipe run, a door sits in a wall, or a switch symbol sits in a circuit.
;;;
;;; It also rotates the block to match. Place a symbol on a sloping or curved
;;; line and the block turns to follow the line's direction at that point,
;;; automatically, before the gap is cut.
;;;
;;; Doing this by hand means BREAK with two carefully snapped points, twice
;;; over, plus a ROTATE with a reference angle -- for every symbol. BlockNotch
;;; replaces all of it with one pick.
;;;
;;; ---------------------------------------------------------------------------
;;; HOW IT WORKS
;;;
;;; 1. BOUNDING BOX
;;;    The block's true extents are measured by walking its definition and
;;;    unioning the bounding boxes of the geometry inside. Text, MText and
;;;    attribute definitions are deliberately excluded -- a long label would
;;;    otherwise inflate the box and gouge a gap far wider than the symbol.
;;;    Objects on frozen layers and invisible objects are excluded for the
;;;    same reason. Nested blocks are measured recursively.
;;;
;;;    Measuring the definition rather than calling GetBoundingBox on the
;;;    reference matters: AutoCAD's own bounding box for a dynamic block is
;;;    frequently wrong, reporting the extents of the unmodified definition
;;;    rather than the current state.
;;;
;;; 2. ROTATION
;;;    Every curve near the block is tested and the one passing closest to
;;;    the block's insertion point wins -- but only if it passes within a
;;;    ten-thousandth of a unit, so a block merely NEAR a line is left alone.
;;;    The curve's first derivative at that point gives the tangent direction,
;;;    which becomes the block's rotation. The angle is then flipped if
;;;    necessary so the block never ends up upside-down.
;;;
;;; 3. THE CUT
;;;    A temporary closed polyline is drawn around the block's outline. Every
;;;    nearby curve is intersected with it, the two intersection points
;;;    furthest apart are found, and BREAK removes the span between them. The
;;;    temporary polyline is then deleted.
;;;
;;;    Taking the FURTHEST-APART pair is what makes this robust. A line
;;;    crossing the box produces two intersections and either pair works; but
;;;    a line crossing a re-entrant or rotated outline can produce four, and
;;;    breaking between the wrong pair would leave a fragment inside the
;;;    block or cut away far too much.
;;;
;;; ---------------------------------------------------------------------------
;;; WHAT GETS TRIMMED
;;;
;;; Arcs, ellipses, circles, lines, xlines, splines, polylines and
;;; lightweight polylines. Anything else near the block is ignored.
;;;
;;; ---------------------------------------------------------------------------
;;; CAVEATS
;;;
;;; The gap is rectangular, aligned to the block. A round symbol therefore
;;; gets a square gap; that is normal for schematic work but is worth knowing.
;;;
;;; Automatic rotation is a stored setting shared by all three commands, and
;;; is changed by typing R at any of their selection prompts. It survives
;;; between sessions.
;;;
;;; ---------------------------------------------------------------------------
;;;   BLOCKNOTCH - insert a block, rotate it to the line, and cut the gap
;;;   NOTCHBLOCK - cut the gap around an existing block, repeatedly
;;;   NOTCHALL   - cut the gap around every block in a selection
;;; ---------------------------------------------------------------------------

(vl-load-com)

;;; ---------------------------------------------------------------------------
;;; Name of the stored rotation setting. Held in the Windows registry through
;;; getenv/setenv, so the preference survives between drawings and sessions.
;;; ---------------------------------------------------------------------------

(setq *BlockNotch:Key* "YZ\\BlockNotchRotation")

(if (null (getenv *BlockNotch:Key*))
    (setenv *BlockNotch:Key* "ON")
)

;;; ---------------------------------------------------------------------------
;;; Cached document, block collection and layer collection.
;;;
;;; Each walks the ActiveX object chain once, then rewrites itself to return
;;; the cached object directly. The bounding box routine queries the layer
;;; collection once per object inside every block, so this matters.
;;; ---------------------------------------------------------------------------

(defun BlockNotch:Doc nil
    (eval (list 'defun 'BlockNotch:Doc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (BlockNotch:Doc)
)

(defun BlockNotch:Blocks nil
    (eval (list 'defun 'BlockNotch:Blocks 'nil (vla-get-blocks (BlockNotch:Doc))))
    (BlockNotch:Blocks)
)

(defun BlockNotch:Layers nil
    (eval (list 'defun 'BlockNotch:Layers 'nil (vla-get-layers (BlockNotch:Doc))))
    (BlockNotch:Layers)
)

;;; ---------------------------------------------------------------------------
;;; BlockNotch:AskRotation
;;;
;;; Prompts for the automatic rotation setting and stores the answer. Pressing
;;; Enter keeps the current value.
;;; ---------------------------------------------------------------------------

(defun BlockNotch:AskRotation ( )
    (initget "ON OFF")
    (setenv *BlockNotch:Key*
        (cond
            (   (getkword
                    (strcat "\nAutomatic block rotation [ON/OFF] <"
                            (getenv *BlockNotch:Key*) ">: ")
                )
            )
            (   (getenv *BlockNotch:Key*))
        )
    )
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; BlockNotch:RotationOn
;;;
;;; Returns T when automatic rotation is enabled.
;;; ---------------------------------------------------------------------------

(defun BlockNotch:RotationOn nil
    (= "ON" (getenv *BlockNotch:Key*))
)

;;; ---------------------------------------------------------------------------
;;; BlockNotch:EndUndo / BlockNotch:StartUndo
;;;
;;; Undo group control. EndUndo loops on bit 8 of UNDOCTL, which stays set
;;; while any group is open, so a group left open by an interrupted operation
;;; is also closed. StartUndo closes anything open before beginning, so the
;;; new group can never be nested inside a stale one.
;;; ---------------------------------------------------------------------------

(defun BlockNotch:EndUndo ( )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark (BlockNotch:Doc))
    )
    (princ)
)

(defun BlockNotch:StartUndo ( )
    (BlockNotch:EndUndo)
    (vla-startundomark (BlockNotch:Doc))
    (princ)
)

;;; ===========================================================================
;;; BLOCKNOTCH  -  insert a block and cut the gap
;;; ===========================================================================
;;;
;;; At the selection prompt the user may:
;;;   * pick an existing block on screen, to insert another copy of it;
;;;   * press Enter to reuse the last-inserted block (INSNAME);
;;;   * type N to name a block already defined in this drawing;
;;;   * type B to browse for an external .dwg to insert;
;;;   * type R to change the automatic rotation setting.
;;; ---------------------------------------------------------------------------

(defun c:BlockNotch ( / *error* blk ins nme obj sel vals vars )

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

    (defun *error* ( msg )
        ;; A block copied for insertion but never placed would be left
        ;; floating at the original's location, so it is removed.
        (if (and (= 'vla-object (type obj))
                 (not (vlax-erased-p obj))
                 (vlax-write-enabled-p obj)
            )
            (vl-catch-all-apply 'vla-delete (list obj))
        )
        (BlockNotch:EndUndo)
        (mapcar 'setvar vars vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** BLOCKNOTCH error: " msg " **"))
        )
        (princ)
    )

    (setvar 'cmdecho 0)

    ;; The bounding box cache is emptied at the start of every run so that a
    ;; block redefined since the last run is measured afresh. Within the run
    ;; it stays hot, which is what keeps repeated insertions fast.
    (setq *BlockNotch:BoxCache* nil)

    (cond
        ;;  ---- refuse to work on a locked layer -------------------------
        ;;  The insertion would silently fail, leaving the user to wonder
        ;;  why nothing appeared.
        (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))
            (princ "\nCurrent layer is locked.")
        )

        ;;  ---- choose the block -----------------------------------------
        ;;  The loop repeats until a block is settled on or the user presses
        ;;  Enter with nothing available. The condition is inverted (while
        ;;  NOT ...) so that every branch returning nil means "ask again".
        (   (progn
                (while
                    (not
                        (progn
                            (setvar 'errno 0)
                            (initget "Browse Name Rotation")
                            (princ (strcat "\nAutomatic block rotation: "
                                           (getenv *BlockNotch:Key*)))
                            (setq sel
                                (entsel
                                    (strcat "\nSelect block [Browse/Name/Rotation]"
                                        (if (= "" (setq blk (getvar 'insname)))
                                            ": "
                                            (strcat " <" blk ">: ")
                                        )
                                    )
                                )
                            )
                            (cond
                                ;;  ERRNO 7 means the pick found nothing.
                                (   (= 7 (getvar 'errno))
                                    (princ "\nMissed, try again.")
                                )
                                ;;  Enter pressed: accept INSNAME if it holds
                                ;;  something, otherwise leave the loop empty
                                ;;  handed.
                                (   (null sel)
                                    (not (if (= "" blk) (setq blk nil)))
                                )
                                (   (= "Rotation" sel)
                                    (BlockNotch:AskRotation)
                                    nil
                                )
                                (   (= "Name" sel)
                                    (while
                                        (not
                                            (or (= "" (setq nme
                                                        (getstring t
                                                            (strcat "\nSpecify block name"
                                                                (if (= "" blk) ": " (strcat " <" blk ">: "))
                                                            )
                                                        )
                                                      )
                                                )
                                                (tblsearch "block" nme)
                                            )
                                        )
                                        (princ (strcat "\nBlock \"" nme
                                                       "\" is not defined in this drawing."))
                                    )
                                    (cond
                                        (   (/= "" nme) (setq blk nme))
                                        (   (/= "" blk))
                                    )
                                )
                                ;;  Browse: an external drawing inserted as a
                                ;;  block. 16 keeps the full path, which is
                                ;;  what vla-InsertBlock needs.
                                (   (= "Browse" sel)
                                    (setq blk (getfiled "Select Block" "" "dwg" 16))
                                )
                                ;;  Picked an object on screen: copy it, so
                                ;;  the new insertion inherits scale, layer
                                ;;  and any dynamic property values already
                                ;;  set on the original.
                                (   (listp sel)
                                    (if (/= "INSERT" (cdr (assoc 0 (entget (car sel)))))
                                        (princ "\nObject must be a block.")
                                        (setq obj (vla-copy (vlax-ename->vla-object (car sel)))
                                              blk (BlockNotch:Name obj)
                                        )
                                    )
                                )
                            )
                        )
                    )
                )
                (not (or blk obj))
            )
            ;;  Nothing to insert; the loop above has already explained why.
        )

        ;;  ---- place it and cut -----------------------------------------
        (   (setq ins (getpoint (strcat "\nSpecify insertion point for "
                                        (vl-filename-base blk) " block: ")))
            (BlockNotch:StartUndo)

            (if (null obj)
                (setq obj
                    (vla-insertblock
                        (vlax-get-property (BlockNotch:Doc)
                            (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)
                        )
                        (vlax-3d-point (trans ins 1 0))
                        blk
                        1.0 1.0 1.0
                        ;; Rotation matching the current UCS, so a block
                        ;; inserted in a rotated UCS starts out square to
                        ;; the screen rather than to the world.
                        (angle '(0.0 0.0 0.0)
                               (trans (getvar 'ucsxdir) 0
                                      (trans '(0.0 0.0 1.0) 1 0 t) t)
                        )
                    )
                )
            )
            ;; Remember the block for next time. Wrapped because INSNAME
            ;; rejects names containing characters it considers illegal.
            (if blk
                (vl-catch-all-apply 'setvar (list 'insname (vl-filename-base blk)))
            )
            (vla-put-insertionpoint obj (vlax-3d-point (trans ins 1 0)))
            (BlockNotch:Cut (vlax-vla-object->ename obj) (BlockNotch:RotationOn))
            (setq obj nil)   ;; placed successfully; the error handler must not delete it
            (BlockNotch:EndUndo)
        )
    )

    (mapcar 'setvar vars vals)
    (princ)
)

;;; ===========================================================================
;;; NOTCHBLOCK  -  cut the gap around an existing block, repeatedly
;;; ===========================================================================
;;;
;;; Loops until the user presses Enter, so a run of symbols already placed can
;;; be dealt with in one command.
;;; ---------------------------------------------------------------------------

(defun c:NotchBlock ( / *error* enx sel vals vars )

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

    (defun *error* ( msg )
        (BlockNotch:EndUndo)
        (mapcar 'setvar vars vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** NOTCHBLOCK error: " msg " **"))
        )
        (princ)
    )

    (setvar 'cmdecho 0)
    (setq *BlockNotch:BoxCache* nil)

    (while
        (progn
            (setvar 'errno 0)
            (initget "Rotation")
            (princ (strcat "\nAutomatic block rotation: " (getenv *BlockNotch:Key*)))
            (setq sel (entsel "\nSelect block to trim around [Rotation]: "))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (= "Rotation" sel)
                    (BlockNotch:AskRotation)
                )
                (   (= 'ename (type (car sel)))
                    (cond
                        (   (/= "INSERT" (cdr (assoc 0 (setq enx (entget (car sel))))))
                            (princ "\nObject must be a block.")
                        )
                        ;;  Bit 4 of DXF 70 on the layer record means locked.
                        (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 enx)))))))
                            (princ "\nSelected block is on a locked layer.")
                        )
                        (   t
                            (BlockNotch:StartUndo)
                            (BlockNotch:Cut (car sel) (BlockNotch:RotationOn))
                            (BlockNotch:EndUndo)
                        )
                    )
                    t   ;; keep looping for the next block
                )
                ;;  Anything else (Enter) ends the command.
            )
        )
    )

    (mapcar 'setvar vars vals)
    (princ)
)

;;; ===========================================================================
;;; NOTCHALL  -  cut the gap around every block in a selection
;;; ===========================================================================

(defun c:NotchAll ( / *error* cnt idx sel vals vars )

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

    (defun *error* ( msg )
        (BlockNotch:EndUndo)
        (mapcar 'setvar vars vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** NOTCHALL error: " msg " **"))
        )
        (princ)
    )

    (setvar 'cmdecho 0)
    (setq *BlockNotch:BoxCache* nil
          cnt 0
    )

    (princ "\nSelect blocks to trim around...")
    (if (setq sel (ssget "_:L" '((0 . "INSERT"))))
        (progn
            (BlockNotch:StartUndo)
            ;; Worked through backwards: BREAK deletes and recreates the
            ;; objects it cuts, so iterating forwards over a live selection
            ;; set risks stepping onto entities that no longer exist.
            (repeat (setq idx (sslength sel))
                (BlockNotch:Cut (ssname sel (setq idx (1- idx))) (BlockNotch:RotationOn))
                (setq cnt (1+ cnt))
            )
            (BlockNotch:EndUndo)
            (princ (strcat "\n" (itoa cnt) " block"
                           (if (= 1 cnt) "" "s") " processed."))
        )
        (princ "\nNothing selected.")
    )

    (mapcar 'setvar vars vals)
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; BlockNotch:Cut
;;;
;;; The engine. Optionally rotates the block to the curve running through it,
;;; then trims every nearby curve to the block's rectangular outline.
;;;
;;;   ent - block reference entity name
;;;   rot - non-nil to rotate the block to the curve first
;;; ---------------------------------------------------------------------------

(defun BlockNotch:Cut

    ( ent rot /
      *error* ang bbx brk crv cur der dis dnear enx guide idx ins int lst
      oldecho par sel tgt
    )

    (defun *error* ( msg )
        ;; The temporary outline polyline must never survive an error --
        ;; it would be left in the drawing looking like real geometry.
        (if (and (= 'vla-object (type guide))
                 (not (vlax-erased-p guide))
                 (vlax-write-enabled-p guide)
            )
            (vl-catch-all-apply 'vla-delete (list guide))
        )
        (if (= 'int (type oldecho)) (setvar 'cmdecho oldecho))
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** BlockNotch error: " msg " **"))
        )
        (princ)
    )

    (if (and (= 'ename (type ent))
             (setq enx (entget ent))
             (= "INSERT" (cdr (assoc 0 enx)))
        )
        (progn

            ;; ---- 1. rotate the block to the curve ---------------------------
            (if
                (and
                    rot
                    (setq bbx (BlockNotch:BoundingBox (vlax-ename->vla-object ent)))
                    ;; "_C" is a crossing window over the block's own outline,
                    ;; which is the cheapest way to reduce the whole drawing to
                    ;; the handful of objects that could possibly be relevant.
                    (setq sel
                        (ssget "_C"
                            (trans (car   bbx) 0 1)
                            (trans (caddr bbx) 0 1)
                           '((0 . "ARC,ELLIPSE,CIRCLE,LINE,XLINE,SPLINE,*POLYLINE"))
                        )
                    )
                    (progn
                        ;; The insertion point in DXF 10 is in the block's own
                        ;; coordinate system, so it is transformed to world.
                        (setq ins   (trans (cdr (assoc 10 enx)) ent 0)
                              crv   (ssname sel (1- (sslength sel)))
                              dnear (distance ins (vlax-curve-getclosestpointto crv ins))
                        )
                        ;; Keep whichever candidate passes nearest the
                        ;; insertion point.
                        (repeat (setq idx (1- (sslength sel)))
                            (setq cur (ssname sel (setq idx (1- idx))))
                            (if (< (setq dis (distance ins (vlax-curve-getclosestpointto cur ins)))
                                   dnear)
                                (setq dnear dis
                                      crv   cur
                                )
                            )
                        )
                        ;; Only rotate if the curve genuinely passes THROUGH
                        ;; the insertion point. Without this test a block
                        ;; placed in empty space near a line would spin to
                        ;; match that unrelated line.
                        (< dnear 1e-4)
                    )
                    (setq par (vlax-curve-getparamatpoint crv
                                  (vlax-curve-getclosestpointto crv ins)
                              )
                    )
                    ;; At an exact endpoint the first derivative is undefined
                    ;; or misleading, so the sample point is nudged a
                    ;; thousandth of a unit inwards along the curve.
                    (progn
                        (cond
                            (   (equal par (vlax-curve-getendparam crv) 1e-8)
                                (setq par (vlax-curve-getparamatdist crv
                                              (- (vlax-curve-getdistatparam crv par) 1e-3)))
                            )
                            (   (equal par (vlax-curve-getstartparam crv) 1e-8)
                                (setq par (vlax-curve-getparamatdist crv
                                              (+ (vlax-curve-getdistatparam crv par) 1e-3)))
                            )
                        )
                        ;; The derivative is a direction vector; its angle in
                        ;; the curve's own extrusion plane is the tangent
                        ;; angle, and therefore the block's rotation.
                        (setq der (vlax-curve-getfirstderiv crv par)
                              ang (angle '(0.0 0.0 0.0)
                                         (trans der 0 (cdr (assoc 210 (entget crv))))
                              )
                        )
                        ;; Keep the block the right way up: any angle in the
                        ;; left half of the circle is flipped by 180 degrees,
                        ;; which points it the same way visually without ever
                        ;; being upside-down.
                        (or (<= ang (/ pi 2.0))
                            (< (/ (* 3.0 pi) 2.0) ang)
                            (setq ang (+ ang pi))
                        )
                        t
                    )
                )
                ;; Set through ActiveX rather than entmod so that any
                ;; attributes attached to the block rotate with it.
                (vla-put-rotation (vlax-ename->vla-object ent) ang)
            )

            ;; ---- 2. build the outline and cut -------------------------------
            ;; The bounding box is recomputed because the rotation above will
            ;; have changed it.
            (if
                (and
                    (setq bbx (BlockNotch:BoundingBox (vlax-ename->vla-object ent)))
                    (setq sel
                        (ssget "_C"
                            (trans (car   bbx) 0 1)
                            (trans (caddr bbx) 0 1)
                           '((0 . "ARC,ELLIPSE,CIRCLE,LINE,XLINE,SPLINE,*POLYLINE"))
                        )
                    )
                )
                (progn
                    ;; A temporary closed 4-vertex lightweight polyline around
                    ;; the block. It exists only to be intersected against and
                    ;; is deleted a few lines later.
                    (setq guide
                        (vlax-ename->vla-object
                            (entmakex
                                (append
                                    (list
                                       '(000 . "LWPOLYLINE")
                                       '(100 . "AcDbEntity")
                                       '(100 . "AcDbPolyline")
                                       '(090 . 4)                     ;; four vertices
                                       '(070 . 1)                     ;; closed
                                        (cons 38 (cadddr (assoc 10 enx)))  ;; elevation
                                    )
                                    ;; LWPOLYLINE vertices are 2D. Each 3D point
                                    ;; is turned into (10 x y z) and then mapped
                                    ;; against a 3-element list, which truncates
                                    ;; it to (10 x y) -- exactly the DXF pair
                                    ;; required.
                                    (mapcar
                                       '(lambda ( p )
                                            (mapcar '+ (cons 10 (trans p 0 ent)) '(0 0 0))
                                        )
                                        bbx
                                    )
                                    (list (assoc 210 enx))             ;; same extrusion as the block
                                )
                            )
                        )
                    )

                    ;; Collect intersections first, cut afterwards. BREAK
                    ;; deletes and recreates entities, which would invalidate
                    ;; the selection set if the two were interleaved.
                    (repeat (setq idx (sslength sel))
                        (setq tgt (ssname sel (setq idx (1- idx))))
                        ;; acExtendThisEntity extends the target curve (not the
                        ;; outline) when looking for intersections, so a line
                        ;; stopping a hair short of the box is still caught.
                        (if (setq int (BlockNotch:Intersections
                                          (vlax-ename->vla-object tgt) guide
                                          acextendthisentity
                                      )
                            )
                            (setq lst (cons (cons tgt int) lst))
                        )
                    )

                    (vla-delete guide)
                    (setq guide nil)

                    (setq oldecho (getvar 'cmdecho))
                    (setvar 'cmdecho 0)
                    (foreach item lst
                        (if (setq brk (BlockNotch:FurthestApart (cdr item)))
                            ;; The entity is named explicitly as (ename point)
                            ;; so BREAK operates on exactly the object intended
                            ;; even where several overlap. "_F" then supplies
                            ;; both break points; "_non" suppresses object snap
                            ;; so the computed points are used verbatim.
                            (command "_.break" (list (car item) (trans (car brk) 0 1)) "_F"
                                     "_non" (trans (car  brk) 0 1)
                                     "_non" (trans (cadr brk) 0 1)
                            )
                        )
                    )
                    (setvar 'cmdecho oldecho)
                )
            )
        )
    )
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; BlockNotch:FurthestApart
;;;
;;; Given a list of points, returns the two that are furthest apart.
;;;
;;; This is what decides where the break happens. A curve crossing a rotated
;;; or re-entrant outline can produce more than two intersection points;
;;; breaking between the outermost pair removes the whole span through the
;;; block, whereas any other pair would leave a fragment behind or cut short.
;;;
;;; Every pair is compared, which is exhaustive but trivial in cost -- these
;;; lists hold two to four points.
;;;
;;; Returns (point point), or nil if fewer than two points were supplied.
;;; ---------------------------------------------------------------------------

(defun BlockNotch:FurthestApart ( lst / dis mxd out pt1 pt2 )
    (setq mxd 0.0)
    (while (setq pt1 (car lst))
        (foreach pt2 (setq lst (cdr lst))
            (if (< mxd (setq dis (distance pt1 pt2)))
                (setq mxd dis
                      out (list pt1 pt2)
                )
            )
        )
    )
    out
)

;;; ---------------------------------------------------------------------------
;;; BlockNotch:Intersections
;;;
;;; Returns every point where two objects intersect, as a list of 3D world
;;; points.
;;;
;;; The IntersectWith method returns a single flat list of coordinates --
;;; x y z x y z x y z -- rather than a list of points, so it is regrouped
;;; three at a time.
;;;
;;;   obj1, obj2 - VLA objects
;;;   mode       - acExtendOption enum controlling which object may be
;;;                extended to find an intersection
;;; ---------------------------------------------------------------------------

(defun BlockNotch:Intersections ( obj1 obj2 mode / flat out )
    (setq flat (vlax-invoke obj1 'intersectwith obj2 mode))
    (repeat (/ (length flat) 3)
        (setq out  (cons (list (car flat) (cadr flat) (caddr flat)) out)
              flat (cdddr flat)
        )
    )
    (reverse out)
)

;;; ---------------------------------------------------------------------------
;;; BlockNotch:BoundingBox
;;;
;;; Returns four world points describing the rectangle that bounds all the
;;; drawable geometry of a block reference, in the order:
;;;   lower-left, lower-right, upper-right, upper-left
;;;
;;; The measurement is taken from the block DEFINITION, not from the
;;; reference. AutoCAD's GetBoundingBox on a dynamic block reference is
;;; unreliable, frequently returning the extents of the unmodified definition
;;; rather than the current visual state; walking the definition avoids that
;;; entirely.
;;;
;;; Excluded from the measurement:
;;;   * Text, MText and attribute definitions -- a long label would blow the
;;;     box out and cut a gap far wider than the symbol.
;;;   * Invisible objects.
;;;   * Objects on frozen layers, which are not drawn and so should not
;;;     influence the gap.
;;;
;;; Nested block references are measured recursively.
;;;
;;; Results are cached per block name in *BlockNotch:BoxCache*, since the
;;; walk is expensive and a drawing typically contains many copies of the
;;; same symbol. The cache holds the box in the block's OWN coordinates; the
;;; per-reference position, rotation and scale are applied afterwards by the
;;; transform below, so one cached box serves every instance.
;;;
;;; The cache is cleared at the start of each top-level command, so a block
;;; redefined between runs is re-measured.
;;;
;;;   blk - VLA block reference object
;;; ---------------------------------------------------------------------------

(defun BlockNotch:BoundingBox ( blk / bnm llp lst urp )
    (setq bnm (strcase (vla-get-name blk)))
    (cond
        (   (setq lst (cdr (assoc bnm *BlockNotch:BoxCache*))))
        (   (progn
                (vlax-for obj (vla-item (BlockNotch:Blocks) bnm)
                    (cond
                        ;;  A nested block: recurse, which returns points
                        ;;  already placed correctly within this definition.
                        (   (= "AcDbBlockReference" (vla-get-objectname obj))
                            (setq lst (append lst (BlockNotch:BoundingBox obj)))
                        )
                        ;;  Ordinary geometry that should count towards the box.
                        (   (and
                                (= :vlax-true (vla-get-visible obj))
                                (not (wcmatch (vla-get-objectname obj)
                                              "AcDbAttributeDefinition,AcDb*Text"))
                                (vlax-method-applicable-p obj 'getboundingbox)
                                (= :vlax-false
                                   (vla-get-freeze (vla-item (BlockNotch:Layers) (vla-get-layer obj)))
                                )
                                ;; GetBoundingBox fails on some degenerate
                                ;; objects, e.g. a zero-length line.
                                (not (vl-catch-all-error-p
                                         (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))
                                     )
                                )
                            )
                            (setq lst (vl-list* (vlax-safearray->list llp)
                                                (vlax-safearray->list urp)
                                                lst
                                      )
                            )
                        )
                    )
                )
                lst
            )
            ;; Reduce the accumulated corner points to one overall minimum and
            ;; one overall maximum, then expand those into the four corners of
            ;; the rectangle.
            (setq lst (mapcar '(lambda ( fn ) (apply 'mapcar (cons fn lst))) '(min max)))
            (setq lst
                (list
                    (car lst)                                ;; lower left
                    (list (caadr lst) (cadar  lst))          ;; lower right
                    (cadr lst)                               ;; upper right
                    (list (caar  lst) (cadadr lst))          ;; upper left
                )
            )
            (setq *BlockNotch:BoxCache* (cons (cons bnm lst) *BlockNotch:BoxCache*))
        )
    )
    ;; Apply this particular reference's placement: multiply each corner by
    ;; the 3x3 rotation/scale matrix, then add the insertion offset.
    (apply
       '(lambda ( mat vec )
            (mapcar '(lambda ( p ) (mapcar '+ (BlockNotch:MxV mat p) vec)) lst)
        )
        (BlockNotch:RefGeom (vlax-vla-object->ename blk))
    )
)

;;; ---------------------------------------------------------------------------
;;; BlockNotch:RefGeom
;;;
;;; Returns the placement of a block reference as two parts:
;;;   1. a 3x3 matrix combining its extrusion, rotation and X/Y/Z scales
;;;   2. the world-space offset of its insertion point
;;;
;;; Together these convert any point expressed in the block definition's own
;;; coordinates into world coordinates. This is what allows one cached
;;; bounding box, measured once from the definition, to serve every insertion
;;; of that block at any position, angle and scale -- including nested ones,
;;; where the transforms compose naturally through the recursion.
;;;
;;; The matrix is built by multiplying three simpler ones, applied
;;; right-to-left: scale first, then rotation, then the extrusion (OCS to
;;; WCS) transform.
;;;
;;; The offset subtracts the transformed definition base point from the world
;;; insertion point, so a block whose base point is not at its own origin is
;;; still placed correctly.
;;;
;;;   ent - block reference entity name
;;; ---------------------------------------------------------------------------

(defun BlockNotch:RefGeom ( ent / ang enx mat ocs )
    (setq enx (entget ent)
          ang (cdr (assoc 050 enx))     ;; rotation
          ocs (cdr (assoc 210 enx))     ;; extrusion direction
    )
    (list
        (setq mat
            (BlockNotch:MxM
                ;; Extrusion: the three world axes expressed in the object's
                ;; own coordinate system.
                (mapcar '(lambda ( v ) (trans v 0 ocs t))
                   '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
                )
                (BlockNotch:MxM
                    ;; Rotation about Z.
                    (list
                        (list (cos ang) (- (sin ang)) 0.0)
                        (list (sin ang) (cos ang)     0.0)
                       '(0.0 0.0 1.0)
                    )
                    ;; Scale: DXF 41, 42 and 43 are the X, Y and Z factors.
                    (list
                        (list (cdr (assoc 41 enx)) 0.0 0.0)
                        (list 0.0 (cdr (assoc 42 enx)) 0.0)
                        (list 0.0 0.0 (cdr (assoc 43 enx)))
                    )
                )
            )
        )
        (mapcar '- (trans (cdr (assoc 10 enx)) ocs 0)
            (BlockNotch:MxV mat
                (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx)))))
            )
        )
    )
)

;;; ---------------------------------------------------------------------------
;;; Matrix helpers.
;;;
;;;   MxV - multiplies matrix m by vector v: each row is dotted with v.
;;;   Trp - transposes a matrix by mapping list across its rows.
;;;   MxM - multiplies matrix m by matrix n: each row of m is multiplied by
;;;         the transpose of n, which turns matrix multiplication into a
;;;         series of matrix-by-vector operations.
;;; ---------------------------------------------------------------------------

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

(defun BlockNotch:Trp ( m )
    (apply 'mapcar (cons 'list m))
)

(defun BlockNotch:MxM ( m n )
    (   (lambda ( a ) (mapcar '(lambda ( row ) (BlockNotch:MxV a row)) m))
        (BlockNotch:Trp n)
    )
)

;;; ---------------------------------------------------------------------------
;;; BlockNotch:Name
;;;
;;; Returns a block reference's true name.
;;;
;;; A dynamic block whose parameters have been changed is stored under an
;;; anonymous name such as "*U12"; EffectiveName gives the name the user
;;; actually sees. That property does not exist in very old releases, so the
;;; function tests once and then redefines itself to the correct version,
;;; removing the test from every later call.
;;; ---------------------------------------------------------------------------

(defun BlockNotch:Name ( obj )
    (if (vlax-property-available-p obj 'effectivename)
        (defun BlockNotch:Name ( obj ) (vla-get-effectivename obj))
        (defun BlockNotch:Name ( obj ) (vla-get-name obj))
    )
    (BlockNotch:Name obj)
)

(princ "\nBlockNotch loaded. BLOCKNOTCH - insert & trim | NOTCHBLOCK / NOTCHALL - trim existing.")
(princ)

;;; ---------------------------------------------------------------------------
;;; End of file
;;; ---------------------------------------------------------------------------