;;; ---------------------------------------------------------------------------
;;; SpiralStair.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; 3D SPIRAL STAIR
;;;
;;; PURPOSE
;;;   Builds a spiral stair as real 3D surfaces - treads winding round a centre
;;;   column, climbing to a given height over a given sweep, with a railing.
;;;
;;;   Two railing treatments:
;;;
;;;     Panels      the treads are one surface and the inner and outer railings
;;;                 are separate panels of a stated thickness. Use this when the
;;;                 railing is a solid balustrade you may want to hide, colour
;;;                 or take off separately.
;;;
;;;     Continuous  the tread and its railing upstands are one unbroken surface,
;;;                 which reads as a folded plate stair and is lighter to carry.
;;;
;;;   Nothing in AutoCAD draws this. Modelling it by hand means arraying a tread
;;;   about an axis while also raising it, which ARRAY will not do in one pass.
;;;
;;; HOW IT IS BUILT
;;;   Each tread is one row of points around the spiral. Walking up the stair, a
;;;   row is generated at each angular step, and every row is added to a growing
;;;   point list. The whole list is then handed to 3DMESH in one go, which
;;;   stitches the rows into a continuous surface.
;;;
;;;   That is why the row point-order matters and is preserved exactly: 3DMESH
;;;   reads the list as a grid, M rows by N columns, and any change to the order
;;;   twists the surface.
;;;
;;;   Each finished mesh is then flagged closed in the N direction, so the
;;;   surface wraps rather than leaving a seam down the stair.
;;;
;;; DIRECTION AND SWEEP
;;;   A positive height climbs, a negative one descends - useful for drawing a
;;;   stair down to a basement from the floor above. The sweep is the angle
;;;   turned between the first and last tread, so 360 gives a full turn and 270
;;;   the common quarter-short spiral.
;;;
;;;   SPIRALSTAIR  - build a 3D spiral stair
;;; ---------------------------------------------------------------------------

;;; ---------------------------------------------------------------------------
;;; SESSION MEMORY
;;; ---------------------------------------------------------------------------

(if (null *SpiralStair:Prefs*)
    (setq *SpiralStair:Prefs*
        (list (cons "RIN"    6.0)      ; inner radius, the centre column
              (cons "ROUT"  36.0)      ; outer radius
              (cons "SWEEP" 360.0)     ; degrees turned, first tread to last
              (cons "HEIGHT" 108.0)    ; total climb, negative to descend
              (cons "STEPS"  16)       ; number of treads
              (cons "RAILW"   2.0)     ; railing width on plan
              (cons "RAILH"  36.0)     ; railing height above the tread
              (cons "RAILT"   1.0)     ; railing panel thickness, Panels only
              (cons "TYPE"   "Panels")
        )
    )
)

(defun SpiralStair:Get ( key ) (cdr (assoc key *SpiralStair:Prefs*)))

(defun SpiralStair:Put ( key val )
    (setq *SpiralStair:Prefs*
        (cons (cons key val)
              (vl-remove-if '(lambda (p) (= (car p) key)) *SpiralStair:Prefs*)))
    val
)

(defun SpiralStair:AskDist ( key prompt / v )
    (initget 6)
    (setq v (getdist (strcat "\n" prompt " <" (rtos (SpiralStair:Get key) 2 3) ">: ")))
    (if v (SpiralStair:Put key v) (SpiralStair:Get key))
)

;;; Height may be negative - a stair going down is as valid as one going up.
(defun SpiralStair:AskReal ( key prompt / v )
    (initget 2)
    (setq v (getreal (strcat "\n" prompt " <" (rtos (SpiralStair:Get key) 2 3) ">: ")))
    (if v (SpiralStair:Put key v) (SpiralStair:Get key))
)

(defun SpiralStair:AskInt ( key prompt / v )
    (initget 6)
    (setq v (getint (strcat "\n" prompt " <" (itoa (SpiralStair:Get key)) ">: ")))
    (if v (SpiralStair:Put key v) (SpiralStair:Get key))
)

;;; ---------------------------------------------------------------------------
;;; HELPERS
;;; ---------------------------------------------------------------------------

;;; The same point raised by h. Every tread is built from a plan point plus a
;;; height, so this is the workhorse of the whole routine.
(defun SpiralStair:Up ( pt h )
    (list (car pt) (cadr pt) (+ (caddr pt) h))
)

;;; Close the mesh just created in its N direction.
;;;
;;; Group 70 on a polygon mesh is a bit field: 16 marks it as a 3D polygon mesh
;;; and 32 closes it in N. Setting 48 sets both, which wraps the surface round
;;; instead of leaving an open seam.
(defun SpiralStair:CloseMesh ( / en ed )
    (if (setq en (entlast))
        (progn
            (setq ed (entget en))
            (if (assoc 70 ed)
                (entmod (subst (cons 70 48) (assoc 70 ed) ed)))))
    (princ)
)

;;; Hand a flat list of points to 3DMESH as an M by N grid.
(defun SpiralStair:Mesh ( pts n / m )
    (setq m (/ (length pts) n))
    (if (> m 1)
        (progn
            (command "_.3DMESH" m n)
            (foreach p pts (command p))
            (command "")
            (SpiralStair:CloseMesh)))
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; MAIN COMMAND
;;; ---------------------------------------------------------------------------

(defun c:SPIRALSTAIR ( / *error* vars vals cen startAng rIn rOut sweepDeg sweep
                         height steps railW railH railT kind
                         dAng dRise a base
                         p1 p2 p3 p4 pa pb
                         b1 b2 b3a b4a b5 b6 b3b b4b
                         tread inner outer meshN )

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

    (defun SpiralStair: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 )
        (SpiralStair:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** SPIRALSTAIR 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.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")

    (initget 1)
    (setq cen (getpoint "\nCentre of the stair: "))

    (initget 1)
    (setq startAng (getangle cen "\nDirection of the first tread: "))

    (setq rIn      (SpiralStair:AskDist "RIN"    "Inner radius, the centre column")
          rOut     (SpiralStair:AskDist "ROUT"   "Outer radius")
          sweepDeg (SpiralStair:AskReal "SWEEP"  "Degrees turned, first tread to last")
          height   (SpiralStair:AskReal "HEIGHT" "Total climb, negative to go down")
          steps    (SpiralStair:AskInt  "STEPS"  "Number of treads"))

    (initget "Panels Continuous")
    (setq kind (getkword (strcat "\nRailing [Panels/Continuous] <"
                                 (SpiralStair:Get "TYPE") ">: ")))
    (if kind (SpiralStair:Put "TYPE" kind))
    (setq kind (SpiralStair:Get "TYPE"))

    (setq railW (SpiralStair:AskDist "RAILW" "Railing width on plan")
          railH (SpiralStair:AskDist "RAILH" "Railing height above the tread"))

    (if (= kind "Panels")
        ;; Held negative because the panel is built downward from its top edge.
        (setq railT (- (SpiralStair:AskDist "RAILT" "Railing panel thickness")))
        (setq railT 0.0))

    (cond
        ((<= rOut rIn)
         (princ "\n** The outer radius must be larger than the inner. **"))

        ((>= (* 2.0 railW) (- rOut rIn))
         (princ "\n** The railings are wider than the tread between them. **"))

        ((zerop height)
         (princ "\n** A stair with no rise is a floor. **"))

        (t
            (setvar "OSMODE" 0)
            (setvar "BLIPMODE" 0)

            (setq sweep  (* pi (/ sweepDeg 180.0))
                  dAng   (/ sweep steps)
                  ;; One more row of points than treads, so the rise per row is
                  ;; over steps+1 rather than steps.
                  dRise  (/ height (1+ steps))
                  a      (- startAng dAng)
                  base   cen
                  ;; 3DMESH reads the point list as an M by N grid. Each pass of
                  ;; the loop below contributes TWO mesh rows, so the column count
                  ;; is half the points that pass adds: 8 points at 4 columns for
                  ;; a plain tread, 16 at 8 columns when the railings are folded
                  ;; into the same surface. Get this wrong and the surface twists.
                  meshN  (if (= kind "Panels") 4 8)
                  tread nil inner nil outer nil)

            ;; --- walk up the stair, one row of points per tread -------------
            (repeat (1+ steps)

                (setq a  (+ a dAng)
                      p1 (polar base a rIn)      ; inner edge of the tread
                      p2 (polar base a rOut)     ; outer edge
                      p3 (SpiralStair:Up p1 dRise)
                      p4 (SpiralStair:Up p2 dRise))

                ;; The trailing edge sits a rise below going up, above going down.
                (if (minusp height)
                    (setq pa (SpiralStair:Up p1 (* 2.0 dRise))
                          pb (SpiralStair:Up p2 (* 2.0 dRise)))
                    (setq pa (SpiralStair:Up p1 (- dRise))
                          pb (SpiralStair:Up p2 (- dRise))))

                ;; The two ends of the run need squaring off, or the first tread
                ;; hangs below the floor and the last runs past the landing.
                (if (and (equal a startAng 0.001) (not (minusp height)))
                    (setq pa p1 pb p2))
                (if (and (equal a (+ startAng sweep) 0.001) (minusp height))
                    (setq pa (SpiralStair:Up p1 dRise)
                          pb (SpiralStair:Up p2 dRise)))

                ;; Railing setting-out, inner then outer.
                (setq b1  (SpiralStair:Up p1 railH)
                      b2  (polar b1 a railW)
                      b3a (polar p1 a railW)
                      b4a (polar base a (- rOut railW))
                      b5  (SpiralStair:Up b4a railH)
                      b6  (polar b5 a railW)
                      b3b (SpiralStair:Up b3a dRise)
                      b4b (SpiralStair:Up b4a dRise))

                (if (= kind "Panels")
                    ;; Tread surface on its own, railings as separate panels.
                    (setq tread (append tread (list pa p1 p2 pb pa p3 p4 pb))
                          inner (append inner (list b1 b2 (SpiralStair:Up b2 railT)
                                                          (SpiralStair:Up b1 railT)))
                          outer (append outer (list b5 b6 (SpiralStair:Up b6 railT)
                                                          (SpiralStair:Up b5 railT))))
                    ;; One unbroken surface: tread and both upstands together.
                    (setq tread (append tread
                                    (list pa b1 b2 b3a b4a b5 b6 pb
                                          pa b1 b2 b3b b4b b5 b6 pb))))

                ;; The centre climbs with the stair, so the next row is generated
                ;; at the height it belongs at.
                (setq base (list (car base) (cadr base) (+ (caddr base) dRise)))
            )

            ;; --- build the surfaces -----------------------------------------
            (SpiralStair:Mesh tread meshN)
            ;; The railing panels are always four points to a row - top edge out,
            ;; then back along the bottom edge.
            (if inner
                (progn
                    (SpiralStair:Mesh inner 4)
                    (SpiralStair:Mesh outer 4)))

            (princ (strcat "\nSpiral stair built - " (itoa steps) " treads, "
                           (rtos (abs height) 2 2)
                           (if (minusp height) " down" " up") " over "
                           (rtos sweepDeg 2 1) " degrees, riser "
                           (rtos (abs (/ height steps)) 2 3) "."))
        )
    )

    (SpiralStair:Restore)
    (princ)
)

(princ)