;;; ---------------------------------------------------------------------------
;;; SpiralPath.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; A RISING HELIX AS A POLYLINE
;;;
;;; PURPOSE
;;;   Draws a helix that climbs as it turns, as an ordinary 3D polyline.
;;;
;;;   AutoCAD has had a HELIX command since 2007 and it asks for much the same
;;;   numbers, so why this? Because HELIX makes a HELIX object - a spline
;;;   underneath - and there are things you cannot usefully do with one. You
;;;   cannot offset it, you cannot get at its vertices, and exploding it gives
;;;   a spline rather than segments.
;;;
;;;   A polyline you can offset, trim, edit vertex by vertex, and hand to a
;;;   machine as a toolpath. That is the whole reason to keep this.
;;;
;;;   For a FLAT spiral, use SPIRAL in SHOPSHAPES - it already draws one as a
;;;   polyline and there is no sense having two.
;;;
;;; WHAT WAS FIXED
;;;   - The flat spiral could not run. Its point generator kept a vertical
;;;     position in a variable that was only ever given a value in the 3D case;
;;;     in the flat case both it and its increment stayed nil, and the first
;;;     (+ nil nil) stopped it.
;;;   - The 3D version began (command "3dpoly") with no starting point, so the
;;;     helix did not begin where you told it to.
;;;   - Pi was typed in by hand as 3.141596235. The real value is 3.141592653 -
;;;     the fifth and sixth decimals are wrong, which is enough that a spiral of
;;;     any length drifts off where it should be and never quite closes.
;;;     AutoLISP has PI built in.
;;;   - The error handler was written, then the two lines that installed it were
;;;     commented out - so there was none. Worse, both commands ended with
;;;     (setq *error* olderr) where olderr had never been given a value, which
;;;     set the session's error handler to nil. After running it once, every
;;;     later error in ANY routine reported as a bare AutoCAD message with no
;;;     cleanup.
;;;
;;;   HELIX3D  - a rising helix as a 3D polyline
;;; ---------------------------------------------------------------------------

(defun Spiral:Layer ( name colour )
    (if (not (tblsearch "LAYER" name))
        (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord")
                       '(100 . "AcDbLayerTableRecord") (cons 2 name)
                       '(70 . 0) (cons 62 colour) '(6 . "Continuous"))))
    name
)

;;; A 3D polyline: header, one vertex each, then a SEQEND to close the run.
;;; Flag 8 on the header and 32 on each vertex are what make it three
;;; dimensional rather than flat.
(defun Spiral:Poly3d ( pts layer )
    (entmake (list '(0 . "POLYLINE") (cons 8 layer) '(66 . 1) '(70 . 8)
                   '(10 0.0 0.0 0.0)))
    (foreach p pts
        (entmake (list '(0 . "VERTEX") (cons 8 layer) (cons 10 p) '(70 . 32))))
    (entmake (list '(0 . "SEQEND") (cons 8 layer)))
)

(defun Spiral:Poly2d ( pts layer )
    (entmake (append
        (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 layer)
              '(100 . "AcDbPolyline") (cons 90 (length pts)) '(70 . 0))
        (mapcar '(lambda ( p ) (cons 10 (list (car p) (cadr p)))) pts)))
)

;;; The points. RISE is nil for a flat spiral; when it is a number the spiral
;;; climbs by that much per turn.
(defun Spiral:Points ( cen turns start growth perTurn rise / pts n i frac r a z )
    (setq n (* turns perTurn) i 0 pts nil)
    (while (<= i n)
        (setq frac (/ (float i) perTurn)     ; turns completed so far
              r    (+ start (* growth frac))
              a    (* 2.0 pi frac)
              z    (if rise (* rise frac) 0.0))
        (setq pts (cons (list (+ (car cen)  (* r (cos a)))
                              (+ (cadr cen) (* r (sin a)))
                              (+ (caddr cen) z))
                        pts)
              i (1+ i)))
    (reverse pts)
)

(defun Spiral:Run ( three / *error* vars vals cen turns start growth per rise
                            lay pts v )

    (setq vars '("CMDECHO" "BLIPMODE" "OSMODE" "CLAYER")
          vals (mapcar 'getvar vars))

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

    (setvar "CMDECHO" 0)
    (setvar "BLIPMODE" 0)
    ;; AutoCAD 2015 and later refuse (command) inside an *error* handler unless
    ;; the routine says up front that it will use one.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")

    (initget 1)
    (setq cen (getpoint "\nCentre point: "))
    (setvar "OSMODE" 0)

    (initget 7)
    (setq turns (getint "\nNumber of turns: "))

    (initget 5)
    (setq start (getdist cen "\nStarting radius <0>: "))
    (if (null start) (setq start 0.0))

    (initget 3)
    (setq growth (getdist "\nRadius gained per turn: "))

    (if three
        (progn (initget 3)
               (setq rise (getdist "\nHeight gained per turn: "))))

    (initget 6)
    (setq per (getint "\nPoints per turn <36>: "))
    (if (null per) (setq per 36))

    (if (or (null cen) (null turns) (null growth) (and three (null rise)))
        (princ "\nCancelled.")
        (progn
            (setq cen (list (car cen) (cadr cen)
                            (cond ((caddr cen)) (t 0.0)))
                  lay (Spiral:Layer "Spiral" 4)
                  pts (Spiral:Points cen turns start growth per rise))

            (if three (Spiral:Poly3d pts lay) (Spiral:Poly2d pts lay))

            (princ (strcat "\n" (itoa turns) " turns, "
                           (itoa (length pts)) " vertices, final radius "
                           (rtos (+ start (* growth turns)) 2 3)
                           (if three
                               (strcat ", rising " (rtos (* rise turns) 2 3))
                               "")
                           ".")))
    )

    (Spiral:Restore)
    (princ)
)

(defun c:HELIX3D ( ) (Spiral:Run t))

(princ)