Generates a stair section from two picked points.
The stair is drawn as a lightweight polyline with a dynamic preview and can optionally generate a nosing and an MTEXT design report.
Works in any UCS and scales to insunits.
Replaces the old STAIR and STAIRM
Notice: the version on github may be newer than the present one.
Command
Digit STAIR at the prompt.
Downloads
Here or from github - most recent
WORKFLOW
- Pick Base Point
- Pick Arrival Point
- Review Preview
- Modify stair parameters if needed
- Accept or Exit
MAIN MENU
[+/-/Tread/Nosing/Accept/Exit] <Accept>
| Action | Description |
|---|---|
| + | Add one riser |
| - | Remove one riser |
| Tread | Tread settings |
| Nosing | Nosing settings |
| Accept | Create final geometry |
| Exit | Cancel command |
MENU TREE
STAIR
├─ Pick Base Point
├─ Pick Arrival Point
│
├─ Main Menu
│ ├─ +
│ │ └─ Add riser
│ │
│ ├─ -
│ │ └─ Remove riser
│ │
│ ├─ Tread
│ │ ├─ Value
│ │ │ └─ Fixed tread value
│ │ │
│ │ ├─ Ergonomic
│ │ │ └─ Automatic Blondel rule
│ │ │
│ │ ├─ Fit
│ │ │ └─ Fit stair to picked run
│ │ │
│ │ └─ Accept
│ │
│ ├─ Nosing
│ │ ├─ None
│ │ │
│ │ ├─ Square
│ │ │ ├─ Nosing X
│ │ │ └─ Nosing Y
│ │ │
│ │ ├─ Round
│ │ │ └─ Diameter
│ │ │
│ │ └─ Cancel
│ │
│ ├─ Accept
│ │ ├─ Final geometry
│ │ └─ Optional MTEXT report
│ │
│ └─ Exit
│ └─ Delete preview
│
└─ End
TREAD MODES
ERGONOMIC
Tread automatically calculated using:
2R + T ≈ 63 cm
scaled to drawing INSUNITS (works in inches, feets, millimeters and meters).
FIXEDTREAD
User specifies a tread value.
Same value is remembered between sessions.
FIT
Total run is constrained by picked points.
Formula:
tread = totalRun / (risers - 1)
where:
totalRun = abs(ep.x - bp.x)
NOSING TYPES
NONE
Standard stair profile.
SQUARE
Rectangular nosing.
Parameters:
- X projection
- Y drop
ROUND
Semicircular nosing.
Parameter:
- Diameter
REPORT
Preview report is shown in the prompt during editing with ⚠ alert if 50° < angle <20°.
Sample:
Preview -> 14 risers of 11.96 | 13 treads of 39.08 | Height 167.46 | Run 508.01 | 2R+T 63.00 | Tread ERGONOMIC | Nosing SQUARE | Angle 18.2° ⚠
Final report contains:
- Height
- Run
- Number of risers
- Number of treads
- Rise value
- Tread value
- 2R+T
- Stair angle
MTEXT REPORT
(Optional)
Automatically inserted:
- Above last step
- UCS aligned
- Height = rise / 3
- Remembers Yes/No preference
- ⚠ alert if 50° < angle <20°
NOTES
- UCS independent.
- insunits independent.
- Run direction automatically detected.
- Preview geometry and parameters.
- Accept promotes preview to final geometry.
- Exit deletes preview geometry.
command: stair
You can edit the code here: GitHub
(vl-load-com)
;------------------------------------------------------------
; STAIR v1.0.0 - First release
; State Infrastructure
; ✅ Geometry Engine frozen
; ✅ UCS Independent
; ✅ Tread submenu
; ✅ Nosing submenu
; ✅ Preview report
; ✅ Final report su command line
; ✅ Accept / Cancel
; ✅ MTEXT report
; ✅ added FIT (constrained) mode (from A to B)
;.. #### next step: add landings ####
;
; Stair section generator
;
;;; Copyright (C) 2026 Andrea Ricci con l'aiuto dell'A.I. (amico immaginario).
;;; https://andrearicci.it
;;;
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
;;; See the GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;;
;;; Author: Andrea Ricci
;;; Version: v1.0.0
;------------------------------------------------------------
; STAIR - USER GUIDE
;------------------------------------------------------------
;
; PURPOSE
;
; Generates a stair section from two picked points.
; The stair is drawn as a lightweight polyline and can optionally generate a nosing and an MTEXT design report
;
; COMMAND
;
; STAIR
; Main command.
;
;
; WORKFLOW
;
; 1) Pick Base Point
; 2) Pick Arrival Point
; 3) Review Preview
; 4) Modify stair parameters if needed
; 5) Accept or Exit
;
;
; MAIN MENU
;
; [+/-/Tread/Nosing/Accept/Exit] <Accept>
;
; + Add one riser
; - Remove one riser
; Tread Tread settings
; Nosing Nosing settings
; Accept Create final geometry
; Exit Cancel command
;
;
; MENU TREE
;
; STAIR
; ├─ Pick Base Point
; ├─ Pick Arrival Point
; │
; ├─ Main Menu
; │ ├─ +
; │ │ └─ Add riser
; │ │
; │ ├─ -
; │ │ └─ Remove riser
; │ │
; │ ├─ Tread
; │ │ ├─ Value
; │ │ │ └─ Fixed tread value
; │ │ │
; │ │ ├─ Ergonomic
; │ │ │ └─ Automatic Blondel rule
; │ │ │
; │ │ ├─ Fit
; │ │ │ └─ Fit stair to picked run
; │ │ │
; │ │ └─ Accept
; │ │
; │ ├─ Nosing
; │ │ ├─ None
; │ │ │
; │ │ ├─ Square
; │ │ │ ├─ Nosing X
; │ │ │ └─ Nosing Y
; │ │ │
; │ │ ├─ Round
; │ │ │ └─ Diameter
; │ │ │
; │ │ └─ Cancel
; │ │
; │ ├─ Accept
; │ │ ├─ Final geometry
; │ │ └─ Optional MTEXT report
; │ │
; │ └─ Exit
; │ └─ Delete preview
; │
; └─ End
;
;
; TREAD MODES
;
; ERGONOMIC
;
; Tread automatically calculated using:
; 2R + T ≈ 63 cm
; according to drawing INSUNITS.
;
; FIXEDTREAD
;
; User specifies a tread value.
; Same value is remembered between sessions.
;
; FIT
;
; Total run is constrained by picked points.
;
; Formula:
; tread = totalRun / (risers - 1)
; where:
; totalRun = abs(ep.x - bp.x)
;
;
; NOSING TYPES
;
; NONE
; Standard stair profile.
;
; SQUARE
; Rectangular nosing.
; Parameters:
; X projection
; Y drop
;
;
; ROUND
; Semicircular nosing.
; Parameter:
; Diameter
;
; REPORT
; Preview report is shown during editing.
; Final report contains:
;
; Height
; Run
; Number of risers
; Number of treads
; Rise value
; Tread value
; 2R+T
; Stair angle
;
;
; MTEXT REPORT
; Optional.
;
; Automatically inserted:
;
; - Above last step
; - UCS aligned
; - Height = rise / 3
; - Remembers Yes/No preference
;
;
; NOTES
;
; - UCS independent.
; - insunits independent.
; - Run direction automatically detected.
; - Preview geometry is temporary.
; - Accept promotes preview to final geometry.
; - Exit deletes preview geometry.
;
;------------------------------------------------------------
; Commands:
; STAIR
;------------------------------------------------------------
;------------------------------------------------------------
; Runtime state
;------------------------------------------------------------
(setq *stair-doc* nil)
(setq *stair-preview* nil)
(setq *stair-mode* "ERGONOMIC")
(setq *stair-fixed-tread* 30.0)
(setq *stair-nosing-type* "NONE")
(setq *stair-bp* nil)
(setq *stair-ep* nil)
(setq *stair-height* 0.0)
(setq *stair-risers* 0)
(setq *stair-rise* 0.0)
(setq *stair-tread* 0.0)
(setq *stair-rundir* 1.0)
(setq *stair-report-mtext* "No")
(setq *stair-total-run* 0.0)
;------------------------------------------------------------
; Helpers
;------------------------------------------------------------
(defun stair:f2 (x)
(rtos x 2 2)
)
(defun stair:sign (x)
(if (>= x 0.0)
1.0
-1.0
)
)
(defun stair:round-int (x)
(fix (+ x 0.5))
)
;------------------------------------------------------------
; Unit conversion
;------------------------------------------------------------
(defun stair:cm->units (v / u)
(setq u (getvar "INSUNITS"))
(* v
(cond
((= u 0) 1.0)
((= u 4) 10.0)
((= u 5) 1.0)
((= u 6) 0.01)
((= u 1) 0.3937007874)
((= u 2) 0.03280839895)
(T 1.0)
)
)
)
(defun stair:ergonomic-min ()
(stair:cm->units 63.0)
)
(defun stair:ergonomic-max ()
(stair:cm->units 64.0)
)
(defun stair:ideal-riser ()
(stair:cm->units 16.5)
)
(defun stair:default-square-x ()
(stair:cm->units 2.0)
)
(defun stair:default-square-y ()
(stair:cm->units 2.0)
)
(defun stair:default-round-dia ()
(stair:cm->units 2.0)
)
(setq *stair-nosing-x* (stair:default-square-x))
(setq *stair-nosing-y* (stair:default-square-y))
(setq *stair-fixed-tread* (stair:cm->units 30.0))
;------------------------------------------------------------
; Ergonomic helpers
;------------------------------------------------------------
(defun stair:get-height (bp ep)
;; Height is always Delta Y in UCS
(abs
(- (cadr ep)
(cadr bp)
)
)
)
(defun stair:propose-risers (height)
(max
2
(stair:round-int
(/
height
(stair:ideal-riser)
)
)
)
)
(defun stair:ergonomic-tread (rise)
(-
(stair:ergonomic-min)
(* 2.0 rise)
)
)
(defun stair:ergonomic-ok-p (rise tread)
(and
(>=
(+ (* 2.0 rise) tread)
(stair:ergonomic-min)
)
(<=
(+ (* 2.0 rise) tread)
(stair:ergonomic-max)
)
)
)
;------------------------------------------------------------
; Recompute stair state
;------------------------------------------------------------
(defun stair:recompute (/)
(setq *stair-rise* (/
*stair-height*
*stair-risers*
)
)
(cond
((= *stair-mode* "ERGONOMIC")
(setq *stair-tread* (stair:ergonomic-tread
*stair-rise*
)
)
)
((= *stair-mode* "FIXEDTREAD")
(setq *stair-tread* *stair-fixed-tread*)
)
((= *stair-mode* "CONSTRAINED")
(if (> (stair:tread-count *stair-risers*) 0)
(setq *stair-tread* (/
*stair-total-run*
(stair:tread-count
*stair-risers*
)
)
)
(setq *stair-tread* 0.0)
)
)
)
(princ)
)
;------------------------------------------------------------
; Refresh preview
;------------------------------------------------------------
(defun stair:refresh-preview (/)
(if
(and
*stair-bp*
(> *stair-risers* 1)
)
(progn
(stair:update-preview *stair-bp* *stair-risers* *stair-rise* *stair-tread*
*stair-rundir*
)
(stair:preview-report
*stair-height*
*stair-risers*
*stair-rise*
*stair-tread*
)
)
)
(princ)
)
;------------------------------------------------------------
; Nosing clamp
;------------------------------------------------------------
(defun stair:clamp-nosing (rise tread nosingType nx ny / maxX maxY changed)
(setq changed nil)
(cond
((= nosingType "SQUARE")
(setq maxX (/ tread 2.0))
(setq maxY (/ rise 2.0))
(if (> nx maxX)
(progn
(setq nx maxX)
(setq changed T)
)
)
(if (> ny maxY)
(progn
(setq ny maxY)
(setq changed T)
)
)
)
((= nosingType "ROUND")
(setq maxY (/ rise 2.0))
(if (> ny maxY)
(progn
(setq ny maxY)
(setq changed T)
)
)
)
)
(if changed
(prompt "\nnosing dimensions out of range")
)
(list nx ny)
)
;------------------------------------------------------------
; Warning helper
;------------------------------------------------------------
(defun stair:warning-mark (ang)
;; Warning if stair angle is outside 20°-50°
(if (or (< ang 20.0) (> ang 50.0))
"\\U+26A0"
""
)
)
;------------------------------------------------------------
; Preview helpers
;------------------------------------------------------------
(defun stair:delete-preview (/)
(if
(and
*stair-preview*
(= (type *stair-preview*) 'VLA-OBJECT)
)
(vl-catch-all-apply
'vla-delete
(list *stair-preview*)
)
)
(setq *stair-preview* nil)
(princ)
)
;------------------------------------------------------------
; Geometry builders
;------------------------------------------------------------
(defun stair:step-none (x y tread rise runDir /)
(list
(list
(list x (+ y rise) 0.0)
0.0
)
(list
(list (+ x (* runDir tread))
(+ y rise)
0.0
)
0.0
)
)
)
(defun stair:step-square (x y tread rise nx ny runDir /)
(list
;; Top of riser minus nose height
(list
(list
x
(+ y (- rise ny))
0.0
)
0.0
)
;; Nose projection
(list
(list
(+ x (* runDir (- nx)))
(+ y (- rise ny))
0.0
)
0.0
)
;; Nose top
(list
(list
(+ x (* runDir (- nx)))
(+ y rise)
0.0
)
0.0
)
;; Tread
(list
(list
(+ x (* runDir tread))
(+ y rise)
0.0
)
0.0
)
)
)
(defun stair:step-round (x y tread rise dia runDir / bulge)
;; Vertical semicircular nosing
(setq bulge (if (> runDir 0.0)
-1.0
1.0
)
)
(list
;; Start of vertical diameter
(list
(list
x
(+ y (- rise dia))
0.0
)
bulge
)
;; End of diameter / top of riser
(list
(list
x
(+ y rise)
0.0
)
0.0
)
;; Tread
(list
(list
(+ x (* runDir tread))
(+ y rise)
0.0
)
0.0
)
)
)
;------------------------------------------------------------
; Geometry engine
;------------------------------------------------------------
(defun stair:build-geometry (risers rise tread runDir nosingType nosingX nosingY /
pts x y v
)
;; Start point of stair profile
(setq pts (list
(list
(list 0.0 0.0 0.0)
0.0
)
)
)
(setq x 0.0)
(setq y 0.0)
;; Main stair profile
(repeat (1- risers)
(setq pts (append
pts
(cond
((= nosingType "SQUARE")
(stair:step-square x y tread rise nosingX nosingY runDir)
)
((= nosingType "ROUND")
(stair:step-round x y tread rise nosingY runDir)
)
(T
(stair:step-none x y tread rise runDir)
)
)
)
)
(setq x (+ x (* runDir tread)))
(setq y (+ y rise))
)
;; Final riser closure
;; Last step completion
(setq pts (append
pts
(cond
;; Last square nose
((= nosingType "SQUARE")
(list
;; Top of final riser
(list
(list
x
(+ y (- rise nosingY))
0.0
)
0.0
)
;; Nose projection
(list
(list
(+ x (* runDir (- nosingX)))
(+ y (- rise nosingY))
0.0
)
0.0
)
;; Nose top
(list
(list
(+ x (* runDir (- nosingX)))
(+ y rise)
0.0
)
0.0
)
;; Return to stair axis
(list
(list
x
(+ y rise)
0.0
)
0.0
)
)
)
;; Last round nose
((= nosingType "ROUND")
(list
(list
(list
x
(+ y (- rise nosingY))
0.0
)
(if (> runDir 0.0)
-1.0
1.0
)
)
(list
(list
x
(+ y rise)
0.0
)
0.0
)
)
)
;; NONE
(T nil)
)
)
)
;; Final riser only for NONE
(if (= nosingType "NONE")
(setq pts (append
pts
(list
(list
(list
x
(+ y rise)
0.0
)
0.0
)
)
)
)
)
pts
)
;------------------------------------------------------------
; Polyline creation
;------------------------------------------------------------
(defun stair:create-polyline (vertices / dxf item pt bulge en)
(setq dxf (list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length vertices))
'(70 . 0)
)
)
(foreach item vertices
(setq pt (car item))
(setq bulge (cadr item))
(setq dxf (append
dxf
(list
(cons 10 pt)
(cons 42 bulge)
)
)
)
)
(setq en (entmakex dxf))
(if en
(vlax-ename->vla-object en)
)
)
;------------------------------------------------------------
; Preview creation
;------------------------------------------------------------
(defun stair:update-preview (basePt risers rise tread runDir / geom)
(stair:delete-preview)
;; Build geometry in local UCS coordinates
(setq geom (stair:build-geometry risers rise tread runDir *stair-nosing-type*
*stair-nosing-x* *stair-nosing-y*
)
)
;; Translate geometry from local stair coordinates
;; to UCS coordinates based on picked base point,
;; then convert UCS -> WCS before creating polyline.
(setq geom (mapcar
'(lambda (v / pt)
(setq pt (list
(+ (car basePt)
(car (car v))
)
(+ (cadr basePt)
(cadr (car v))
)
0.0
)
)
;; UCS -> WCS transformation
(setq pt (trans pt 1 0))
(list
pt
(cadr v)
)
)
geom
)
)
(setq *stair-preview* (stair:create-polyline geom))
(princ)
)
;------------------------------------------------------------
; STAIR:INFO Internal Debug Helper
;------------------------------------------------------------
(defun stair:info (/)
(prompt
(strcat
"\nINSUNITS = "
(itoa (getvar "INSUNITS"))
"\nIdeal riser = "
(stair:f2 (stair:ideal-riser))
"\nErgonomic minimum = "
(stair:f2 (stair:ergonomic-min))
"\nErgonomic maximum = "
(stair:f2 (stair:ergonomic-max))
)
)
(princ)
)
;------------------------------------------------------------
; STAIR:CALC (internal function)
;------------------------------------------------------------
(defun stair:calc (/ bp ep height risers rise tread)
(setq bp (getpoint "\nBase point: "))
(if bp
(progn
(setq ep (getpoint bp "\nArrival point: "))
(if ep
(progn
(setq height (stair:get-height bp ep))
(setq *stair-total-run* (abs
(- (car ep)
(car bp)
)
)
)
(setq risers (stair:propose-risers height))
(setq rise (/ height risers))
(setq tread (stair:ergonomic-tread rise))
(prompt
(strcat
"\nHeight = "
(stair:f2 height)
"\nIdeal riser = "
(stair:f2 (stair:ideal-riser))
"\nRisers = "
(itoa risers)
"\nRise = "
(stair:f2 rise)
"\nTread = "
(stair:f2 tread)
"\n2R+T = "
(stair:f2
(+ (* 2.0 rise)
tread
)
)
)
)
)
)
)
)
(princ)
)
;------------------------------------------------------------
; Stair helpers
;------------------------------------------------------------
(defun stair:get-rundir (bp ep)
;; Left if arrival X < base X
;; Right otherwise (including same X)
(if
(< (car ep)
(car bp)
)
-1.0
1.0
)
)
(defun stair:tread-count (risers)
(max 0 (1- risers))
)
(defun stair:total-run (risers tread)
(* (stair:tread-count risers)
tread
)
)
;------------------------------------------------------------
; Preview report
;------------------------------------------------------------
(defun stair:preview-report (height risers rise tread / run ang warn)
(setq run (stair:total-run risers tread))
(setq ang (if (> run 0.0)
(* 180.0 (/ (atan (/ height run)) pi))
90.0
)
)
(setq warn (stair:warning-mark ang))
(prompt
(strcat
"\nPreview -> "
(itoa risers)
" risers of "
(stair:f2 rise)
" | "
(itoa
(stair:tread-count risers)
)
" treads of "
(stair:f2 tread)
" | Height "
(stair:f2 height)
" | Run "
(stair:f2
(stair:total-run
risers
tread
)
)
" | 2R+T "
(stair:f2
(+ (* 2.0 rise)
tread
)
)
" | Tread "
(cond
((= *stair-mode* "ERGONOMIC")
"ERGONOMIC"
)
((= *stair-mode* "FIXEDTREAD")
(strcat
"FIXED ("
(stair:f2 *stair-fixed-tread*)
")"
)
)
((= *stair-mode* "CONSTRAINED")
"FIT"
)
(T
"UNKNOWN"
)
)
" | Nosing "
*stair-nosing-type*
" | Angle "
(rtos ang 2 1)
"°"
(if (/= warn "")
(strcat " " warn)
""
)
)
)
(princ)
)
;------------------------------------------------------------
; Final report
;------------------------------------------------------------
(defun stair:final-report (/ treadDesc nosingDesc)
;; Tread description
(setq treadDesc (cond
((= *stair-mode* "ERGONOMIC")
"ERGONOMIC"
)
((= *stair-mode* "FIXEDTREAD")
(strcat
"FIXED ("
(stair:f2 *stair-fixed-tread*)
")"
)
)
((= *stair-mode* "CONSTRAINED")
"CONSTRAINED"
)
(T
*stair-mode*
)
)
)
;; Nosing description
(setq nosingDesc (cond
((= *stair-nosing-type* "NONE")
"NONE"
)
((= *stair-nosing-type* "SQUARE")
(strcat
"SQUARE ("
(stair:f2 *stair-nosing-x*)
" x "
(stair:f2 *stair-nosing-y*)
")"
)
)
((= *stair-nosing-type* "ROUND")
(strcat
"ROUND (Ø"
(stair:f2 *stair-nosing-y*)
")"
)
)
(T
*stair-nosing-type*
)
)
)
(prompt
(strcat
"\nStair accepted -> "
(itoa *stair-risers*)
" risers of "
(rtos *stair-rise* 2 3)
" | "
(itoa
(stair:tread-count *stair-risers*)
)
" treads of "
(rtos *stair-tread* 2 3)
" | Height "
(stair:f2 *stair-height*)
" | Run "
(stair:f2
(stair:total-run
*stair-risers*
*stair-tread*
)
)
" | 2R+T "
(stair:f2
(+
(* 2.0 *stair-rise*)
*stair-tread*
)
)
" | Tread "
treadDesc
" | Nosing "
nosingDesc
)
)
(princ)
)
;------------------------------------------------------------
; MTEXT report
;------------------------------------------------------------
(defun stair:create-report-mtext (/ run ang warn txt txtHeight insPt rot obj)
(vl-load-com)
;; Total run
(setq run (stair:total-run
*stair-risers*
*stair-tread*
)
)
;; Stair angle in degrees
(setq ang (* 180.0
(/
(atan (/ *stair-height* run))
pi
)
)
)
;; Warning mark
(setq warn (stair:warning-mark ang))
;; Text height
(setq txtHeight (/ *stair-rise* 3.0))
;; MTEXT contents
(setq txt (strcat
"Height = "
(stair:f2 *stair-height*)
"\\P"
"Run = "
(stair:f2 run)
"\\P"
(itoa *stair-risers*)
" risers of "
(stair:f2 *stair-rise*)
"\\P"
(itoa
(stair:tread-count *stair-risers*)
)
" treads of "
(stair:f2 *stair-tread*)
"\\P"
"2R+T = "
(stair:f2
(+ (* 2.0 *stair-rise*)
*stair-tread*
)
)
"\\P"
warn
(if (/= warn "") " " "")
"Angle = "
(rtos ang 2 1)
"\\U+00B0"
)
)
;; Insertion point in UCS
(setq insPt (list
(+ (car *stair-bp*)
(* *stair-rundir* run)
)
(+ (cadr *stair-bp*)
*stair-height*
(/ *stair-rise* 2.0)
(* 6.0 txtHeight)
*stair-rise*
)
0.0
)
)
;; UCS -> WCS
(setq insPt (trans insPt 1 0))
;; UCS rotation
(setq rot (angle
'(0.0 0.0 0.0)
(getvar "UCSXDIR")
)
)
;; Create MTEXT
(setq obj (vla-AddMText
(vla-get-ModelSpace
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
(vlax-3d-point insPt)
0.0
txt
)
)
;; Properties
(vla-put-Height obj txtHeight)
(vla-put-Rotation obj rot)
;; Bottom Left
(vla-put-AttachmentPoint obj 7)
(princ)
)
;------------------------------------------------------------
; STAIR
;------------------------------------------------------------
(defun c:STAIR (/ bp ep runDir height risers rise tread cmd done ncmd nx ny dia dims
tcmd tv tdone rcmd
)
(defun *error* (msg)
(if
(and msg
(not (wcmatch (strcase msg) "*CANCEL*,*QUIT*"))
)
(prompt
(strcat
"\nError: "
msg
)
)
)
(princ)
)
(setq bp (getpoint
"\nBase point: "
)
)
(if bp
(progn
(setq ep (getpoint
bp
"\nArrival point: "
)
)
(if ep
(progn
;; Determine direction
(setq runDir (stair:get-rundir
bp
ep
)
)
;; Stair height
(setq height (stair:get-height
bp
ep
)
)
(setq *stair-total-run* (abs
(- (car ep)
(car bp)
)
)
)
;; Proposed risers
(setq risers (stair:propose-risers
height
)
)
;; Resulting rise
(setq rise (/
height
risers
)
)
;; Ergonomic tread
(setq tread (stair:ergonomic-tread
rise
)
)
;; Save current stair state
(setq *stair-bp* bp)
(setq *stair-ep* ep)
(setq *stair-height* height)
; (setq *stair-total-run* *stair-total-run*)
(setq *stair-risers* risers)
(setq *stair-rise* rise)
(setq *stair-tread* tread)
(setq *stair-rundir* runDir)
;; Preview
(stair:update-preview bp risers rise tread runDir)
;; Preview report
(stair:preview-report
height
risers
rise
tread
)
;; Correction loop
(setq done nil)
(while (not done)
(initget "+ - Tread Nosing Accept Exit")
(setq cmd (getkword "\n[+/-/Tread/Nosing/Accept/Exit] <Accept>: "))
(if (null cmd) (setq cmd "Accept"))
(cond
;; Tread submenu
((= cmd "Tread")
(setq tdone nil)
(while (not tdone)
(initget "Value Ergonomic Fit Accept")
(setq tcmd (getkword
"\nTread [Value/Ergonomic/Fit/Accept] <Accept>: "
)
)
(if (null tcmd)
(setq tcmd "Accept")
)
(cond
;; Value
((= tcmd "Value")
(setq tv (getreal
(strcat
"\nTread value <"
(stair:f2 *stair-fixed-tread*)
">: "
)
)
)
(if (null tv)
(setq tv *stair-fixed-tread*)
)
(if (> tv 0.0)
(progn
(setq *stair-fixed-tread* tv)
(setq *stair-mode* "FIXEDTREAD")
(stair:recompute)
(stair:refresh-preview)
)
)
)
;; Ergonomic
((= tcmd "Ergonomic")
(setq *stair-mode* "ERGONOMIC")
(stair:recompute)
(stair:refresh-preview)
)
;; Fit
((= tcmd "Fit")
(setq *stair-mode* "CONSTRAINED")
(stair:recompute)
(stair:refresh-preview)
)
;; Accept
((= tcmd "Accept")
(setq tdone T)
)
)
)
)
;; Nosing
((= cmd "Nosing")
(initget "None Square Round Cancel")
(setq ncmd (getkword
(strcat
"\nNosing [None/Square/Round/Cancel] <Cancel>: "
)
)
)
(cond
;; Cancel
((or
(null ncmd)
(= ncmd "Cancel")
)
(princ)
)
;; NONE
((= ncmd "None")
(setq *stair-nosing-type* "NONE")
(stair:refresh-preview)
)
;; SQUARE
((= ncmd "Square")
(setq nx (getreal
(strcat
"\nNosing X <"
(stair:f2 *stair-nosing-x*)
">: "
)
)
)
(if (null nx)
(setq nx *stair-nosing-x*)
)
(setq ny (getreal
(strcat
"\nNosing Y <"
(stair:f2 *stair-nosing-y*)
">: "
)
)
)
(if (null ny)
(setq ny *stair-nosing-y*)
)
(setq dims (stair:clamp-nosing *stair-rise* *stair-tread* "SQUARE"
nx ny
)
)
(setq *stair-nosing-type* "SQUARE")
(setq *stair-nosing-x* (car dims))
(setq *stair-nosing-y* (cadr dims))
(stair:refresh-preview)
)
;; ROUND
((= ncmd "Round")
(setq dia (getreal
(strcat
"\nDiameter <"
(stair:f2 *stair-nosing-y*)
">: "
)
)
)
(if (null dia)
(setq dia *stair-nosing-y*)
)
(setq dims (stair:clamp-nosing *stair-rise* *stair-tread* "ROUND"
0.0 dia
)
)
(setq *stair-nosing-type* "ROUND")
(setq *stair-nosing-y* (cadr dims))
(stair:refresh-preview)
)
)
)
;; Accept
((= cmd "Accept")
;; Promote preview to final geometry
(setq *stair-preview* nil)
(stair:final-report)
(initget "Yes No")
(setq rcmd (getkword
(strcat
"\nCreate text report? [Yes/No] <"
*stair-report-mtext*
">: "
)
)
)
;; Use previous choice as default
(if (null rcmd)
(setq rcmd *stair-report-mtext*)
)
;; Remember user preference
(setq *stair-report-mtext* rcmd)
;; Create MTEXT if requested
(if (= rcmd "Yes")
(stair:create-report-mtext)
)
(setq done T)
)
;; Exit
((= cmd "Exit")
(stair:delete-preview)
(setq done T)
)
;; Add riser
((= cmd "+")
(setq *stair-risers* (1+ *stair-risers*))
(stair:recompute)
(stair:refresh-preview)
)
;; Remove riser
((= cmd "-")
(if (> *stair-risers* 2)
(progn
(setq *stair-risers* (1- *stair-risers*))
(stair:recompute)
(stair:refresh-preview)
)
)
)
)
)
)
)
)
)
(princ)
)
;------------------------------------------------------------
; STAIR (quick instructions)
;------------------------------------------------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ
(strcat "\n----------------------------------------"
"\nSTAIR v1.0.0 - Stair section generator -"
"\n----------------------------------------" "\n" "\nQuick workflow:"
"\n 1. Run STAIR" "\n 2. Pick Base Point" "\n 3. Pick Arrival Point"
"\n 4. Adjust stair parameters" "\n 5. Accept" "\n" "\nTread modes:"
"\n Ergonomic | Fixed Value | Fit (between picked points)" "\n" "\n"
"\nNosing modes:" "\n None | Square | Round" "\n" "\nType STAIR to start."
)
)
(princ)