;; =====================================================================
;; SplitIntoLines.lsp - split lines and polylines into segments
;;                      of a given length or into N equal parts
;; Command: SPLITINTOLINES
;; AutoCAD / GstarCAD (AutoLISP). Description and installation:
;; https://fixcontrol.co/tools/autocad-lisp-scripts
;;
;; WHAT IT DOES:
;;   1. You select lines (LINE) and polylines (LWPOLYLINE).
;;   2. You choose the split mode [Length/Count]:
;;      Length  - segments of the given length (drawing units; type a
;;                number or pick two points). The last segment (the
;;                remainder) is shorter. Split direction [Start/End/Pick]:
;;                  Start - measure from the start of the object,
;;                  End   - from the end (the remainder ends up at the start),
;;                  Pick  - for each object you click near the end
;;                          the measuring should start from
;;                          (the object is highlighted).
;;      Count   - N equal segments (direction does not matter).
;;   3. The object is replaced by the segments. Segments follow the
;;      polyline shape (bends and arcs are kept). A straight segment
;;      becomes a LINE, a segment with a bend or arc becomes a polyline
;;      (see outputType). Segments inherit the original's layer, colour,
;;      linetype and lineweight.
;;   The last values entered are remembered until the program is closed
;;   (Enter = the same). Everything is undone with a single U.
;;   Objects shorter than the given length are skipped.
;;   Old-style 2D/3D polylines (POLYLINE) are not supported - convert
;;   2D polylines with the CONVERTPOLY command.
;;
;; OPTIONS (SETTINGS at the start of the function below):
;;   deleteOriginal - T = delete the original after splitting, nil = keep it
;;   outputType     - "AUTO"  = straight segment -> LINE, with a bend /
;;                              arc -> polyline,
;;                    "PLINE" = every polyline segment as a polyline
;;                    (LINE objects always give LINE segments)
;; =====================================================================

(defun c:SplitIntoLines (/ *error* doc ss mode dir i ent ed total step breaks fromEnd pt sp ep
                           cntObj cntPieces cntSkip deleteOriginal outputType)
  (vl-load-com)

  ;; ---- SETTINGS ----
  (setq deleteOriginal T)
  (setq outputType "AUTO")

  (defun *error* (msg)
    (if ent (redraw ent 4))
    (if doc (vla-endundomark doc))
    (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*,*QUIT*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  (setq doc (vla-get-activedocument (vlax-get-acad-object)))

  (prompt "\nSelect lines and polylines to split: ")
  (if (not (setq ss (ssget '((0 . "LINE,LWPOLYLINE")))))
    (progn (princ "\nNo objects selected.") (exit))
  )

  ;; split mode
  (if (not (member *SIL-mode* '("Length" "Count"))) (setq *SIL-mode* "Length"))
  (initget "Length Count")
  (if (setq mode (getkword (strcat "\nSplit by [Length/Count] <" *SIL-mode* ">: ")))
    (setq *SIL-mode* mode)
    (setq mode *SIL-mode*)
  )

  (if (= mode "Length")
    (progn
      (initget 6)
      (setq step (getdist (if *SIL-len*
                            (strcat "\nSegment length <" (rtos *SIL-len* 2 4) ">: ")
                            "\nSegment length: ")))
      (if step (setq *SIL-len* step) (setq step *SIL-len*))
      (if (not step) (progn (princ "\nNo length entered.") (exit)))

      (if (not (member *SIL-dir* '("Start" "End" "Pick"))) (setq *SIL-dir* "Pick"))
      (initget "Start End Pick")
      (if (setq dir (getkword (strcat "\nSplit direction [Start/End/Pick] <" *SIL-dir* ">: ")))
        (setq *SIL-dir* dir)
        (setq dir *SIL-dir*)
      )
    )
    (progn
      (if (not *SIL-count*) (setq *SIL-count* 2))
      (setq step nil)
      (while (not step)
        (initget 6)
        (setq step (getint (strcat "\nNumber of equal segments <" (itoa *SIL-count*) ">: ")))
        (if (not step) (setq step *SIL-count*))
        (if (< step 2) (progn (princ "\nEnter at least 2.") (setq step nil)))
      )
      (setq *SIL-count* step)
    )
  )

  (vla-startundomark doc)
  (setq cntObj 0 cntPieces 0 cntSkip 0 i 0)
  (repeat (sslength ss)
    (setq ent (ssname ss i) i (1+ i))
    (setq ed (entget ent))
    (setq total (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))

    (cond
      ((or (<= total 1e-9)
           (and (= mode "Length") (<= total (+ step 1e-9))))
       (setq cntSkip (1+ cntSkip)))
      (t
       ;; measuring direction
       (setq fromEnd nil)
       (if (= mode "Length")
         (cond
           ((= dir "End") (setq fromEnd T))
           ((= dir "Pick")
            (setq sp (vlax-curve-getStartPoint ent) ep (vlax-curve-getEndPoint ent))
            (if (> (distance sp ep) 1e-9)
              (progn
                (redraw ent 3)
                (setq pt (getpoint "\nPick the end to measure from: "))
                (redraw ent 4)
                (if pt
                  (progn
                    (setq pt (trans pt 1 0))
                    (setq fromEnd (< (distance (SIL-2d pt) (SIL-2d ep))
                                     (distance (SIL-2d pt) (SIL-2d sp))))
                  )
                )
              )
            )
           )
         )
       )

       (setq breaks
         (if (= mode "Length")
           (SIL-breaks total step fromEnd)
           (SIL-breaks total (/ total step) nil)
         )
       )

       (while (cadr breaks)
         (SIL-piece ent ed (car breaks) (cadr breaks) outputType)
         (setq cntPieces (1+ cntPieces) breaks (cdr breaks))
       )
       (if deleteOriginal (entdel ent))
       (setq cntObj (1+ cntObj))
      )
    )
  )
  (setq ent nil)
  (vla-endundomark doc)

  (princ (strcat "\nSplit " (itoa cntObj) " objects into " (itoa cntPieces) " segments."))
  (if (> cntSkip 0)
    (princ (strcat "\nSkipped " (itoa cntSkip) " objects (shorter than the segment or zero length)."))
  )
  (princ)
)

;; point without the Z coordinate
(defun SIL-2d (p) (list (car p) (cadr p)))

;; list of split distances from the start of the object (ascending, from 0 to total)
(defun SIL-breaks (total step fromEnd / lst d fuzz)
  (setq fuzz (max 1e-8 (* total 1e-9)) lst (list 0.0) d step)
  (while (< d (- total fuzz))
    (setq lst (cons d lst) d (+ d step))
  )
  (setq lst (reverse (cons total lst)))
  (if fromEnd
    (reverse (mapcar '(lambda (x) (- total x)) lst))
    lst
  )
)

;; properties copied to the segments (layer, colour, linetype etc.)
(defun SIL-props (ed)
  (vl-remove-if-not '(lambda (x) (member (car x) '(6 8 39 48 62 370 420 430 440))) ed)
)

;; segment of object ent between distances d1 and d2
(defun SIL-piece (ent ed d1 d2 outputType / props dists k p1 p2 pts bulges da db seg b segLen vtx
                                            normal elev flag)
  (setq props (SIL-props ed))
  (if (= (cdr (assoc 0 ed)) "LINE")
    (entmake (append (list '(0 . "LINE")) props
                     (list (cons 10 (SIL-pt ent d1))
                           (cons 11 (SIL-pt ent d2)))))
    (progn
      ;; distances: d1, vertices in between, d2
      (setq p1 (vlax-curve-getParamAtDist ent d1)
            p2 (vlax-curve-getParamAtDist ent d2))
      (if (not p2) (setq p2 (vlax-curve-getEndParam ent)))
      (setq dists (list d1) k (1+ (fix p1)))
      (while (< k (- p2 1e-9))
        (if (> (- k p1) 1e-9)
          (setq dists (cons (vlax-curve-getDistAtParam ent k) dists))
        )
        (setq k (1+ k))
      )
      (setq dists (reverse (cons d2 dists)))

      ;; bulges of the original segments
      (setq bulges (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) ed)))
      (setq pts nil)
      (while (cadr dists)
        (setq da (car dists) db (cadr dists))
        (setq seg (fix (vlax-curve-getParamAtDist ent (/ (+ da db) 2.0))))
        (setq b (if (nth seg bulges) (nth seg bulges) 0.0))
        (if (/= b 0.0)
          (progn
            (setq segLen (- (vlax-curve-getDistAtParam ent (1+ seg))
                            (vlax-curve-getDistAtParam ent seg)))
            (setq b (SIL-tan (* (atan b) (/ (- db da) segLen))))
          )
        )
        (setq pts (cons (list (SIL-pt ent da) b) pts))
        (setq dists (cdr dists))
      )
      (setq pts (reverse (cons (list (SIL-pt ent (car dists)) 0.0) pts)))

      (if (and (= outputType "AUTO") (= (length pts) 2) (= (cadr (car pts)) 0.0))
        (entmake (append (list '(0 . "LINE")) props
                         (list (cons 10 (car (car pts))) (cons 11 (car (cadr pts))))))
        (progn
          (setq normal (cdr (assoc 210 ed))
                elev   (cdr (assoc 38 ed))
                flag   (logand (cdr (assoc 70 ed)) 128))
          (if (not normal) (setq normal '(0.0 0.0 1.0)))
          (setq vtx nil)
          (foreach p pts
            (setq vtx (cons (cons 42 (cadr p))
                            (cons (cons 10 (SIL-2d (trans (car p) 0 normal))) vtx)))
          )
          (entmake
            (append
              (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity"))
              props
              (list '(100 . "AcDbPolyline") (cons 90 (length pts)) (cons 70 flag))
              (if (assoc 43 ed) (list (assoc 43 ed)))
              (if elev (list (cons 38 elev)))
              (reverse vtx)
              (list (cons 210 normal))
            )
          )
        )
      )
    )
  )
)

(defun SIL-tan (x) (/ (sin x) (cos x)))

;; point at distance d from the start; out of range (rounding errors) -> end / start
(defun SIL-pt (ent d / p)
  (cond
    ((setq p (vlax-curve-getPointAtDist ent d)) p)
    ((<= d 0.0) (vlax-curve-getStartPoint ent))
    (t (vlax-curve-getEndPoint ent))
  )
)

(princ "\nSPLITINTOLINES loaded. Type SPLITINTOLINES to run.")
(princ)