;;; ---------------------------------------------------------------------
;;;  PBRKALL-bgol.lsp
;;;  Command:  PBRK
;;;
;;;  PURPOSE
;;;  Breaks every selected LWPOLYLINE at each point where it crosses any
;;;  other selected LWPOLYLINE, producing individually editable segments
;;;  at every mutual intersection. Useful when preparing road, drainage
;;;  or utility networks for GIS export or topology cleanup.
;;;
;;;  USAGE
;;;    1. Load this file (APPLOAD or drag-drop onto the drawing window).
;;;    2. Type   PBRK   at the command line and press Enter.
;;;    3. Select two or more LWPOLYLINEs that cross one another.
;;;    4. Each selected polyline is broken into separate segments at
;;;       every intersection point. New segments are placed on layer
;;;       "BGOL-PBRK". The original polylines are erased.
;;;
;;;  NOTES
;;;    - This is an original, independently written implementation.
;;;      It is INSPIRED by the general idea of batch break-at-
;;;      intersection utilities common in CAD/survey drafting
;;;      workflows, but the code, command name and file name here are
;;;      new and are NOT copied from, nor identical to, any specific
;;;      third-party product.
;;;
;;;  ---------------------------------------------------------------------
;;;  Developed and shared for the CAD community by:  BGol Community
;;;  Community website:                              https://bgol.in/
;;;  License:  Open-source & free to use, modify, and share for all.
;;;            Provided "as is", without warranty of any kind.
;;;  ---------------------------------------------------------------------

(vl-load-com)

(defun BGOL:PBRK-EnsureLayer (lname / )
  (if (not (tblsearch "LAYER" lname))
    (entmake (list '(0 . "LAYER")
                   '(100 . "AcDbSymbolTableRecord")
                   '(100 . "AcDbLayerTableRecord")
                   (cons 2 lname)
                   '(70 . 0)
                   '(62 . 3)          ; green
                   '(6 . "Continuous")))
  )
)

(defun BGOL:PBRK-MakeSeg (p1 p2 lname / dxfdata)
  (setq dxfdata (list '(0 . "LWPOLYLINE")
                       '(100 . "AcDbEntity")
                       (cons 8 lname)
                       '(100 . "AcDbPolyline")
                       (cons 90 2)
                       '(70 . 0)
                       (cons 10 (list (car p1) (cadr p1)))
                       (cons 10 (list (car p2) (cadr p2)))
                 )
  )
  (entmakex dxfdata)
)

;; Break a single polyline object at a sorted list of parameters (0..1 excl endpoints)
(defun BGOL:PBRK-BreakOne (obj params lname / sp ep plist i p1 p2)
  (setq sp (vlax-curve-getStartParam obj))
  (setq ep (vlax-curve-getEndParam obj))
  (setq params (vl-sort (vl-remove-if '(lambda (x) (or (<= x sp) (>= x ep))) params) '<))
  (setq plist (append (list sp) params (list ep)))
  (setq i 0)
  (while (< i (1- (length plist)))
    (setq p1 (vlax-curve-getPointAtParam obj (nth i plist)))
    (setq p2 (vlax-curve-getPointAtParam obj (nth (1+ i) plist)))
    (if (and p1 p2 (> (distance p1 p2) 1e-6))
      (BGOL:PBRK-MakeSeg p1 p2 lname)
    )
    (setq i (1+ i))
  )
)

(defun C:PBRK ( / ss n ents objs i j obj1 obj2 pts pt paramtbl ename
                  brkcount res params)
  (BGOL:PBRK-EnsureLayer "BGOL-PBRK")
  (princ "\nSelect polylines to break at mutual intersections: ")
  (setq ss (ssget '((0 . "LWPOLYLINE"))))
  (if (and ss (>= (sslength ss) 2))
    (progn
      (setq n (sslength ss))
      (setq ents '())
      (setq objs '())
      (setq i 0)
      (while (< i n)
        (setq ename (ssname ss i))
        (setq ents (append ents (list ename)))
        (setq objs (append objs (list (vlax-ename->vla-object ename))))
        (setq i (1+ i))
      )
      ;; paramtbl: list of param-lists, one per entity, holding intersection params
      (setq paramtbl '())
      (setq i 0)
      (while (< i n) (setq paramtbl (append paramtbl (list '()))) (setq i (1+ i)))
      ;; pairwise intersection
      (setq i 0)
      (while (< i n)
        (setq j (1+ i))
        (while (< j n)
          (setq obj1 (nth i objs))
          (setq obj2 (nth j objs))
          (setq pts (vl-catch-all-apply 'vlax-invoke (list obj1 'IntersectWith obj2 acExtendNone)))
          (if (not (vl-catch-all-error-p pts))
            (progn
              (while pts
                (setq pt (list (car pts) (cadr pts) (caddr pts)))
                (setq res (vl-catch-all-apply 'vlax-curve-getParamAtPoint (list obj1 pt)))
                (if (not (vl-catch-all-error-p res))
                  (setq paramtbl (subst (append (nth i paramtbl) (list res)) (nth i paramtbl) paramtbl))
                )
                (setq res (vl-catch-all-apply 'vlax-curve-getParamAtPoint (list obj2 pt)))
                (if (not (vl-catch-all-error-p res))
                  (setq paramtbl (subst (append (nth j paramtbl) (list res)) (nth j paramtbl) paramtbl))
                )
                (setq pts (cdddr pts))
              )
            )
          )
          (setq j (1+ j))
        )
        (setq i (1+ i))
      )
      ;; now break each polyline at its own collected params
      (setq brkcount 0)
      (setq i 0)
      (while (< i n)
        (setq params (nth i paramtbl))
        (if params
          (progn
            (BGOL:PBRK-BreakOne (nth i objs) params "BGOL-PBRK")
            (entdel (nth i ents))
            (setq brkcount (1+ brkcount))
          )
        )
        (setq i (1+ i))
      )
      (princ (strcat "\nPBRK: " (itoa brkcount) " polyline(s) broken at intersections (layer BGOL-PBRK)."))
    )
    (princ "\nSelect at least two intersecting polylines.")
  )
  (princ)
)

(princ "\nPBRKALL-bgol.lsp loaded. Type PBRK to break polylines at all mutual intersections.")
(princ "\n  -- Free & open-source, courtesy of BGol Community (https://bgol.in/) --")
(princ)