;;; ---------------------------------------------------------------------------
;;; PartOffset.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Offsets only PART of a polyline, to both sides at once.
;;;
;;; The standard OFFSET command works on a whole object. When you only want to
;;; offset the middle stretch of a long polyline - to show a widening, a
;;; crossing, a section of kerb build-out - you normally have to break the
;;; polyline, offset the fragment and then repair the original. This does it
;;; without touching the source polyline at all.
;;;
;;; HOW TO USE IT
;;;   1. Give an offset distance.
;;;   2. Pick the polyline.
;;;   3. Pick two points along it, bracketing the section you want.
;;; Two new polylines appear, one either side of that section. The original is
;;; left exactly as it was.
;;;
;;; The distance is remembered between runs, so repeated use only needs Enter.
;;;
;;; HOW IT WORKS
;;; A temporary polyline is constructed representing just the selected section,
;;; then AutoCAD's own offset is applied to it twice - once positive, once
;;; negative - and the temporary object is deleted. Using the real offset
;;; engine rather than computing parallel geometry by hand is what makes this
;;; handle arc segments and varying width correctly.
;;;
;;; The intricate part is building that temporary polyline, because the picked
;;; points almost never land exactly on a vertex. Where a pick falls part way
;;; along a segment, that segment must be split - and both its WIDTH and its
;;; CURVATURE have to be divided proportionally, or the offset section will not
;;; line up with the polyline it came from.
;;;
;;; Width divides linearly. Curvature does not: it is stored as a bulge, which
;;; is the tangent of a quarter of the arc's included angle, so it has to be
;;; converted to an angle, split, and converted back. That is what the atan and
;;; tangent calls are doing - and getting it wrong is precisely the bug that
;;; version 1.1 of the original was published to fix.
;;;
;;;   PARTOFFSET  - offset a section of a polyline to both sides
;;; ---------------------------------------------------------------------------

(vl-load-com)

;; Last offset distance used, remembered between runs. Global by necessity.
(if (null *PartOffset:Distance*)
    (setq *PartOffset:Distance* 1.0)
)

;; ---------------------------------------------------------------------------
;; PartOffset:Tan
;; ---------------------------------------------------------------------------
;; Tangent of x, returning nil at the asymptotes rather than throwing.
;;
;; Namespaced deliberately - the original defined a bare global "tan", which
;; would silently replace any other function of that name in the session.
;; ---------------------------------------------------------------------------
(defun PartOffset:Tan ( x )
    (if (not (equal 0.0 (cos x) 1e-8))
        (/ (sin x) (cos x))
    )
)

;; ---------------------------------------------------------------------------
;; PartOffset:Vertices
;; ---------------------------------------------------------------------------
;; Returns the polyline's vertices as sublists of their four defining groups:
;; 10 position, 40 starting width, 41 ending width, 42 bulge.
;;
;; Necessary because in raw entity data these groups simply repeat in sequence
;; with no marker between vertices, so assoc cannot be used to reach a
;; particular one.
;; ---------------------------------------------------------------------------
(defun PartOffset:Vertices ( enx )
    (if (setq enx (member (assoc 10 enx) enx))
        (cons
            (list (assoc 10 enx) (assoc 40 enx) (assoc 41 enx) (assoc 42 enx))
            (PartOffset:Vertices (cdr enx))
        )
    )
)

;; ---------------------------------------------------------------------------
;; c:PARTOFFSET  -  main routine
;; ---------------------------------------------------------------------------
(defun c:PARTOFFSET ( / *error* vars vals dist ent pt1 pt2 par1 par2
                        enx head verts extr vertex width temp count )

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

    (defun PartOffset: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 )
        (PartOffset:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** PARTOFFSET error: " msg " **"))
        )
        (princ)
    )

    (setvar "CMDECHO" 0)

    ;; initget 6 rejects zero and negative input - a zero offset would produce
    ;; two copies sitting exactly on the original.
    (initget 6)
    (if (setq dist (getdist (strcat "\nSpecify offset distance <"
                                    (rtos *PartOffset:Distance*) ">: ")))
        (setq *PartOffset:Distance* dist)
        (setq dist *PartOffset:Distance*)
    )

    ;; 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 going until the user presses Enter, so several sections can be
    ;; offset in one command.
    ;; -----------------------------------------------------------------------
    (while
        (progn
            (setvar 'errno 0)
            (setq ent (car (entsel "\nSelect polyline <exit>: ")))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null ent) nil)
                (   (/= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
                    (princ "\nThat object is not an LWPolyline.")
                )
                (   (setq pt1 (getpoint "\nSpecify first point on the polyline: "))

                    ;; Both picks are snapped onto the curve, so the user does
                    ;; not have to click precisely on the line.
                    (setq pt1 (vlax-curve-getclosestpointto ent (trans pt1 1 0)))

                    ;; Reject a second pick that lands on the first - a
                    ;; zero-length section cannot be offset.
                    (while
                        (and (setq pt2 (getpoint (trans pt1 0 1) "\nSpecify second point on the polyline: "))
                             (equal pt1
                                    (setq pt2 (vlax-curve-getclosestpointto ent (trans pt2 1 0)))
                                    1e-8
                             )
                        )
                        (princ "\nThe two points must be distinct.")
                    )

                    (if pt2
                        (progn
                            (setq par1 (vlax-curve-getparamatpoint ent pt1)
                                  par2 (vlax-curve-getparamatpoint ent pt2)
                            )

                            ;; Order the picks along the polyline, so the user
                            ;; may click them in either order.
                            (if (> par1 par2)
                                (mapcar 'set '(par1 par2 pt1 pt2) (list par2 par1 pt2 pt1))
                            )

                            (setq enx   (entget ent)
                                  ;; Header up to and including group 39.
                                  head  (reverse (member (assoc 39 enx) (reverse enx)))
                                  ;; Force the temporary polyline OPEN by
                                  ;; clearing bit 1 of group 70. A section of a
                                  ;; closed polyline is itself open, and leaving
                                  ;; the closed flag set would make the offset
                                  ;; join its two ends across the gap.
                                  head  (subst (cons 70 (logand (cdr (assoc 70 head)) (~ 1)))
                                               (assoc 70 head)
                                               head
                                        )
                                  verts (PartOffset:Vertices enx)
                                  extr  (assoc 210 enx)
                            )

                            ;; Discard every vertex before the first pick.
                            (repeat (fix par1)
                                (setq verts (cdr verts))
                            )

                            ;; ---------------------------------------------------
                            ;; If the first pick fell mid-segment, replace the
                            ;; leading vertex with one at the pick point, its
                            ;; width interpolated and its bulge scaled to the
                            ;; remaining portion of the arc.
                            ;;
                            ;; The min against (1+ (fix par1)) handles the case
                            ;; where BOTH picks lie within the same segment - the
                            ;; bulge must then be scaled to the span between them
                            ;; rather than to the end of the segment.
                            ;; ---------------------------------------------------
                            (if (not (equal par1 (fix par1) 1e-8))
                                (setq vertex (car verts)
                                      width  (cdr (assoc 40 vertex))
                                      verts
                                    (cons
                                        (list
                                            (cons 10 (trans pt1 0 (cdr extr)))
                                            (cons 40 (+ width
                                                        (* (- par1 (fix par1))
                                                           (- (cdr (assoc 41 vertex)) width)
                                                        )
                                                     )
                                            )
                                            (assoc 41 vertex)
                                            (cons 42
                                                (PartOffset:Tan
                                                    (* (- (min par2 (1+ (fix par1))) par1)
                                                       (atan (cdr (assoc 42 vertex)))
                                                    )
                                                )
                                            )
                                        )
                                        (cdr verts)
                                    )
                                )
                            )

                            ;; Work from the far end now: reverse, and trim off
                            ;; every vertex beyond the second pick.
                            (setq verts (reverse verts))
                            (repeat (+ (length verts) (fix par1) (- (fix par2)) -1)
                                (setq verts (cdr verts))
                            )

                            ;; ---------------------------------------------------
                            ;; Same treatment at the far end. The closing vertex
                            ;; carries zero widths and zero bulge because it
                            ;; terminates the polyline - those values describe the
                            ;; segment LEAVING a vertex, and there is none.
                            ;; ---------------------------------------------------
                            (if (not (equal par2 (fix par2) 1e-8))
                                (setq vertex (car verts)
                                      width  (cdr (assoc 40 vertex))
                                      verts
                                    (vl-list*
                                        (list (cons 10 (trans pt2 0 (cdr extr)))
                                             '(40 . 0.0)
                                             '(41 . 0.0)
                                             '(42 . 0.0)
                                        )
                                        (list
                                            (assoc 10 vertex)
                                            (assoc 40 vertex)
                                            (cons 41
                                                (+ width
                                                   (* (/ (- par2 (max par1 (fix par2)))
                                                         (- (1+ (fix par2)) (max par1 (fix par2)))
                                                      )
                                                      (- (cdr (assoc 41 vertex)) width)
                                                   )
                                                )
                                            )
                                            (cons 42
                                                (PartOffset:Tan
                                                    (* (if (< (fix par2) par1) 1.0 (- par2 (fix par2)))
                                                       (atan (cdr (assoc 42 vertex)))
                                                    )
                                                )
                                            )
                                        )
                                        (cdr verts)
                                    )
                                )
                            )

                            ;; -----------------------------------------------
                            ;; Build the temporary section, offset it both
                            ;; ways using AutoCAD's own engine, then remove it.
                            ;;
                            ;; The offsets are caught individually: a tight
                            ;; inside curve can be impossible to offset by the
                            ;; requested distance, and that should cost one
                            ;; side, not the whole operation.
                            ;; -----------------------------------------------
                            (setq temp
                                (vlax-ename->vla-object
                                    (entmakex
                                        (append head
                                                (apply 'append (reverse verts))
                                                (list extr)
                                        )
                                    )
                                )
                            )
                            (vl-catch-all-apply 'vla-offset (list temp dist))
                            (vl-catch-all-apply 'vla-offset (list temp (- dist)))
                            (vla-delete temp)
                            (setq count (1+ count))
                        )
                    )
                    t
                )
            )
        )
    )

    (princ (strcat "\n" (itoa count) " section" (if (= 1 count) "" "s") " offset."))
    (PartOffset:Restore)
    (princ)
)

(princ)