;;; ---------------------------------------------------------------------------
;;; VertexInject.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Inserts a new vertex into an existing LWPolyline at a picked point.
;;;
;;; PEDIT can do this, but only by walking the vertex list one step at a time
;;; until you reach the right segment. This just puts a vertex where you click,
;;; and keeps prompting so several can be added in one go.
;;;
;;; THE HARD PART: PRESERVING THE SEGMENT
;;; Splitting a straight segment is trivial. Splitting a segment that has WIDTH
;;; and CURVATURE is not, because both have to be divided so that the polyline
;;; looks completely unchanged afterwards.
;;;
;;; Width is interpolated linearly. If the segment tapers from 5 to 15 and you
;;; split it a third of the way along, the new vertex must take width 5 + (1/3
;;; of 10) = 8.33, and the two halves then run 5-to-8.33 and 8.33-to-15.
;;;
;;; Curvature is stored as a BULGE, which is the tangent of one quarter of the
;;; arc's included angle. Bulge does not divide linearly, so it has to be
;;; converted back to an angle, split in proportion, and converted to a bulge
;;; again. That is what the arctangent and tangent calls are doing:
;;;
;;;     angle       = atan(bulge)                one quarter of included angle
;;;     firstHalf   = tan(fraction * angle)
;;;     secondHalf  = tan((1 - fraction) * angle)
;;;
;;; Get this wrong and an arc segment silently collapses to a straight line -
;;; which is exactly the bug that version 1.1 of the original was released to
;;; fix, on the closing segment of a closed polyline.
;;;
;;;   VERTINJECT  - add a vertex to an LWPolyline at a picked point
;;; ---------------------------------------------------------------------------

(vl-load-com)

;; ---------------------------------------------------------------------------
;; VertexInject:Tan
;; ---------------------------------------------------------------------------
;; Tangent of x, returning nil rather than throwing at the asymptotes.
;;
;; Namespaced deliberately. The original defined this as a bare global called
;; "tan", which would silently replace any other definition of that name loaded
;; in the same session - a genuine hazard in a library of a hundred routines.
;; ---------------------------------------------------------------------------
(defun VertexInject:Tan ( x )
    (if (not (equal 0.0 (cos x) 1e-10))
        (/ (sin x) (cos x))
    )
)

;; ---------------------------------------------------------------------------
;; VertexInject:Vertices
;; ---------------------------------------------------------------------------
;; Returns the polyline's vertices as a list of sublists, each holding that
;; vertex's four defining groups:
;;
;;   10 - position
;;   40 - starting width
;;   41 - ending width
;;   42 - bulge
;;
;; Grouping them this way matters because in raw entity data these groups are
;; simply repeated in sequence, with nothing to mark where one vertex ends and
;; the next begins - so they cannot be safely manipulated with assoc.
;; ---------------------------------------------------------------------------
(defun VertexInject:Vertices ( enx )
    (if (setq enx (member (assoc 10 enx) enx))
        (cons
            (list (assoc 10 enx) (assoc 40 enx) (assoc 41 enx) (assoc 42 enx))
            (VertexInject:Vertices (cdr enx))
        )
    )
)

;; ---------------------------------------------------------------------------
;; c:VERTINJECT  -  main routine
;; ---------------------------------------------------------------------------
(defun c:VERTINJECT ( / *error* vars vals pt ent enx head count param frac
                        vertices before current width bulge extrusion count )

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

    (defun VertexInject:Restore ( )
        (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 )
        (VertexInject:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** VERTINJECT 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")
    (setq count 0)

    ;; -----------------------------------------------------------------------
    ;; Keep prompting until the user presses Enter. Each unsuitable pick is
    ;; explained and retried rather than ending the command, so a near miss
    ;; costs one more click instead of a restart.
    ;; -----------------------------------------------------------------------
    (while
        (progn
            (setq pt (getpoint "\nSpecify point for new vertex <exit>: "))
            (cond
                (   (null pt) nil)

                ;; nentselp tests what lies at a point without a further pick.
                (   (null (setq ent (nentselp pt)))
                    (princ "\nThat point does not lie on a polyline.")
                )

                ;; A four-element return means the object is nested inside a
                ;; block, where its data cannot be edited in place.
                (   (= 4 (length ent))
                    (princ "\nCannot add vertices to a polyline nested inside a block.")
                )

                (   (/= "LWPOLYLINE" (cdr (assoc 0 (entget (setq ent (car ent))))))
                    (princ "\nThat point does not lie on an LWPolyline.")
                )

                (   t
                    ;; ---------------------------------------------------------
                    ;; Locate the pick along the curve. The parameter's whole
                    ;; part identifies which segment, and its fractional part
                    ;; how far along that segment the point falls.
                    ;; ---------------------------------------------------------
                    (setq pt    (vlax-curve-getclosestpointto ent (trans pt 1 0))
                          param (vlax-curve-getparamatpoint ent pt)
                    )

                    (if (equal param (fix param) 1e-8)
                        ;; A whole-number parameter means the pick landed on an
                        ;; existing vertex, where there is nothing to insert.
                        (princ "\nThere is already a vertex at that point.")

                        (progn
                            (setq enx       (entget ent)
                                  ;; Everything up to and including group 39 is
                                  ;; the entity header, which must be preserved
                                  ;; ahead of the vertex data.
                                  head      (reverse (member (assoc 39 enx) (reverse enx)))
                                  vertices  (VertexInject:Vertices enx)
                                  extrusion (assoc 210 enx)
                                  before    nil
                            )

                            ;; Peel off the vertices preceding the split point.
                            (repeat (fix param)
                                (setq before   (cons (car vertices) before)
                                      vertices (cdr vertices)
                                )
                            )

                            (setq current (car vertices)
                                  frac    (- param (fix param))
                                  ;; Linear width interpolation.
                                  width   (cdr (assoc 40 current))
                                  width   (+ width (* frac (- (cdr (assoc 41 current)) width)))
                                  ;; Bulge converted to its quarter-angle so it
                                  ;; can be divided proportionally.
                                  bulge   (atan (cdr (assoc 42 current)))
                            )

                            (entmod
                                (append
                                    ;; Vertex count, incremented by one.
                                    (subst (cons 90 (1+ (cdr (assoc 90 head))))
                                           (assoc 90 head)
                                           head
                                    )
                                    (apply 'append (reverse before))
                                    (list
                                        ;; First half of the split segment.
                                        (assoc 10 current)
                                        (assoc 40 current)
                                        (cons  41 width)
                                        (cons  42 (VertexInject:Tan (* frac bulge)))
                                        ;; The new vertex.
                                        (cons  10 (trans pt 0 (cdr extrusion)))
                                        (cons  40 width)
                                        (assoc 41 current)
                                        ;; Second half of the split segment.
                                        (cons  42 (VertexInject:Tan (* (- 1.0 frac) bulge)))
                                    )
                                    (apply 'append (cdr vertices))
                                    (list extrusion)
                                )
                            )
                            (setq count (1+ count))
                        )
                    )
                    t
                )
            )
        )
    )

    (princ (strcat "\n" (itoa count) " vertex" (if (= 1 count) "" "es") " added."))
    (VertexInject:Restore)
    (princ)
)

(princ)