Topic: Stair drawing Lisp

[Rob-GB]

Hi all! Thought I would post this up for you, as I tend to drop in and read way more than I post. So about time I did so.
I am sure many of you could make it shorter/tidier etc, but my day job is making stuff out of wood  
Any constructive criticism welcome, thank you.

Code: [Select]

;=========================================================================================;
(defun C:stair3 (/ IP GOING RISE NOSING TRTH RITH STRTH WIDE STEPS a AA B C D E F G H K S N P
Q R R1 R2 R3 R4 R5 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 S1 S2 S3 S4 S5 S6 S7 S8 S9
PT1 PT2 PL1 PL2 PL3 PL4 PL5 PL6 PL7 PL8 PL9 PL10 N1 N2 N3 N4 N5 N6 N7 N8 N9 N10
RWTW TRENCH LEN ANG OLDSNAP OLDBLIP OLDLIGHT OLDLAY)
;=========================================================================================;
; lisp routine to draw basic timber staircase, side elevation and plan view
; by Rob-GB 27.01.2011
; Acknowledgements are due to the many members of Cadtutor and The Swamp who give freely of their time and knowledge.
; Thanks
(setq OLDSNAP (getvar "OSMODE")
)
(setq OLDBLIP (getvar "BLIPMODE") ;store settings
)
(setq OLDLIGHT (getvar "HIGHLIGHT")
)
(setq OLDLAY (getvar "CLAYER")
)
(setvar "CMDECHO" 0)
        (setvar "BLIPMODE" 0)
;=========================================================================================;
;Basic dims required
;=========================================================================================;
(or GOING (setq GOING 230.0)) ;set default dims and allow user input
(or RISE (setq RISE 200.0))
 (or TRTH (setq TRTH 25.0))
  (or RITH (setq RITH 9.0))
   (or WIDE (setq WIDE 900.0))
    (or STRTH (setq STRTH 33.0))
              (or NOSING (setq NOSING 25.0))
         (or STEPS (setq STEPS 13.0))
       (setq AA (rtos GOING 2 1))
(setq B (rtos RISE  2 1))
 (setq C (rtos TRTH  2 1))
          (setq D (rtos RITH  2 1))
   (setq E (rtos WIDE  2 1))
    (setq F (rtos STRTH 2 1))
             (setq G (rtos NOSING 2 1))
                 (setq H (rtos STEPS 2 1))
  
(setq GOING (cond ((getdist (strcat "\nEnter going of tread <"AA">:")))     (T (setq GOING GOING))))
(setq RISE  (cond ((getdist (strcat "\nEnter rise of step <"B">:")))       (T (setq RISE RISE))))
(setq TRTH  (cond ((getdist (strcat "\nEnter tread thickness <"C">:")))    (T (setq TRTH TRTH))))
(setq RITH  (cond ((getdist (strcat "\nEnter riser thickness <"D">:")))    (T (setq RITH RITH))))
(setq WIDE  (cond ((getdist (strcat "\nEnter width across strings <"E">:")))      (T (setq WIDE WIDE))))  
(setq STRTH (cond ((getdist (strcat"\nEnter string thickness <"F">:")))  (T (setq STRTH STRTH))))
(setq NOSING (cond ((getdist (strcat"\nEnter nosing projection <"G">:")))  (T (setq NOSING NOSING))))
(setq STEPS (getint "\nEnter number of risers : "))

(setq IP (getpoint "\nInsertion Point: ")
) ; bottom left finish floor level of first riser, stair will be drawn rising from left to right
;===============================================================================================================;
(defun DTR (a) (* PI (/ a 180.0)) ;degrees to radians
)
;===============================================================================================================;
;;; Layer Function - Set Layer & Linetype.                          ;Function Description
(defun SLL (NLAY CLR LT / LAY FRZ)                                  ;Define function, Declare local variables and arguments
  (setq LAY  (tblsearch "layer" NLAY))                              ;Search drawing to find layer, Note: (NOT USED)
   (if                                                              ;If the following returns true
    (not LAY)                                                       ;Layer not in drawing
     (command "_.layer" "m" NLAY "c" CLR "" "lt" LT "" "")          ;Layer command ~ make new layer with color and linetype
      (progn                                                        ;Then do the following
       (setq FRZ (cdr (assoc 70 LAY)))                              ;Variable FRZ is frozen layer
        (if (= FRZ 65)                                              ;Layer frozen from last edit
         (progn                                                     ;Then do the following
          (command "_.layer" "t" NLAY "")                           ;Thaw new layer if frozen
           (command "_.layer" "s" NLAY ""))                         ;Set new layer
            (command "_.layer" "s" NLAY ""))))                      ;Set new layer
)                                                                   ;End define function  
;=========================================================================================;
(setvar "OSMODE" 0)  
(setq P (* RISE RISE)
 )
  (setq Q (* GOING GOING)
   )
    (setq LEN (SQRT (+ P Q))
     )
      (setq PT1 (POLAR IP (DTR 90.0) RISE)
       )
        (setq PT2 (POLAR PT1 (DTR 0.0) GOING)
)
      
(setq S1 (POLAR IP (DTR 0.0) 100)
 )
  (setq S2 (POLAR IP (DTR 180.0) 150)
   )
    (setq S3 (POLAR S2 (DTR 90.0) 150)
     )
      (setq S4 (POLAR S3 (angle IP PT2) (* STEPS LEN))
       )
        (setq S5 (POLAR S4 (DTR 0.0) 250)
         )
          (setq S6 (POLAR S5 (DTR 270.0) 150)
           )
          (setvar "OSMODE" 0)
         (SLL "String" "63" "CONTINUOUS")     ;Go to SLL Layer Function, Set Layer, Color & Linetype
        (command "_.PLINE" S1 S2 S3 S4 S5 S6 S1 ""
       )
       ; string drawn
;============================================================================================================;
 ;Draw plan view of stair strings
(setq PL1 (POLAR IP (DTR 270.0) 150)
 )
  (setq PL2 (POLAR PL1 (DTR 180.0) 150)
   )
    (setq PL3 (POLAR PL2 (DTR 270.0) STRTH)
     )
      (setq PL4 (POLAR PL3 (DTR 0.0) 150)
       )
        (setq PL5 (POLAR PL4 (DTR 0.0) (+ (* STEPS GOING) 100))
         )
          (setq PL6 (POLAR PL5 (DTR 90.0) STRTH)
           )
      (setq PL7 (POLAR PL2 (DTR 270.0) WIDE)
      )
        (setq PL8 (POLAR PL6 (DTR 270.0) WIDE)
               )
                (setq PL9 (POLAR PL8 (DTR 90.0) STRTH)
                 )
                  (setq PL10 (POLAR PL7 (DTR 90.0) STRTH)
                   ) ;plan view string outlined
;============================================================================================================;
                  (setvar "OSMODE" 0)
(SLL "String" "63" "CONTINUOUS")     ;Go to SLL Layer Function, Set Layer, Color & Linetype
      (command "_.PLINE" PL1 PL2 PL3 PL4 PL5 PL6 PL1 ""
     )
             (command "_.PLINE" PL7 PL8 PL9 PL10 PL7 ""
   )     ; string drawn
;============================================================================================================;
(repeat STEPS
 (setq TRENCH 12)
  (setq RWTW (- WIDE (* STRTH 2))
   )
(setq N1 (POLAR PL4 (DTR 90.0) TRENCH) ;THIS COULD BE CHANGED TO HOUSING DEPTH WITH NEW QUESTION AT START
 )
  (setq N2 (POLAR N1 (DTR 270.0) (+ RWTW (* TRENCH 2)))
   )
    (setq N3 (POLAR N1 (DTR 180.0) NOSING)
     )
      (setq N4 (POLAR N3 (DTR 270.0) (+ RWTW (* TRENCH 2)))
       )
        (setq N5 (POLAR N4 (DTR 0.0) GOING)
         )    
          (setq N6 (POLAR N1 (DTR 0.0) GOING)
           )      
;============================================================================================================;
;set other dims
(setq GR 10) ;sets depth of groove in tread to accept riser
  (setq GRD (- TRTH GR)) ;gives tread thickness less riser groove depth
  
;=========================================================================================;
; plot points for side elevation
(setq R1 (POLAR IP (DTR 90.0) (- RISE GRD)) ; riser side elevation from insert point
 )
  (setq R2 (POLAR R1 (DTR 0.0) RITH)
   )
    (setq R3 (POLAR R2 (DTR 270.0) (- RISE GRD))
     )
      (setq R4 (POLAR R3 (DTR 270.0) TRTH)
       )
        (setq R5 (POLAR R4 (DTR 180.0) RITH)
         )
;====================================================================================;
;treads
(setq T1 (POLAR R1 (DTR 270.0) GR) ; top corner head
 )
  (setq T2 (POLAR T1 (DTR 180.0) NOSING)
   )
    (setq T4 (POLAR T2 (DTR 90.0) TRTH)
     )
      (setq T5 (POLAR IP (DTR 90.0) RISE)
       )  
        (setq T6 (POLAR T5 (DTR 0.0) GOING)
         )
          (setq T7 (POLAR T6 (DTR 270.0) TRTH)
           )
            (setq T8 (POLAR T7 (DTR 180.0) (- GOING RITH))
             )
              (setq T9 (POLAR T2 (DTR 0.0) (/ TRTH 2))
               )
                (setq T10 (POLAR T4 (DTR 0.0) (/ TRTH 2))
                 )
                  (setq T3 (POLAR T9 (DTR 90.0) (/ TRTH 2))              ;centre point for tread nosing
                   )
;=========================================================================================;
(setvar "OSMODE" 0)
       (SLL "Riser" "72" "CONTINUOUS")   ;Go to SLL Layer Function, Set Layer, Color & Linetype
      (command "_.PLINE" IP R1 R2 R3 R4 R5 IP ""
     ); riser drawn
;=========================================================================================;
;plot tread elevation
                  (setvar "OSMODE" 0)
                 (SLL "Tread" "63" "CONTINUOUS")        ;Go to SLL Layer Function, Set Layer, Color & Linetype
                (command "_.PLINE" T10 T5 T6 T7 T8 R2 R1 T1 T9 ""
      )
              (command "arc" "c" T3 T10 T9
    )                 ;nosing
            (setvar "OSMODE" 0)
           (SLL "Riser" "72" "HIDDEN")                  ;Go to SLL Layer Function, Set Layer, Color & Linetype
          (command "_.PLINE" N1 N2 ""
         )        ;draw first riser line plan view
        (setvar "OSMODE" 0)
       (SLL "Tread" "63" "CONTINUOUS")                  ;Go to SLL Layer Function, Set Layer, Color & Linetype
      (command "_.PLINE" N6 N1 N3 N4 N2 N5 ""
     )
    (setq PL4 (POLAR N6 (DTR 270.00) TRENCH)
   )
  (setq IP T6) ;place insert point at last t6 point
 )                                        ;end repeat loop
;=========================================================================================;

;=========================================================================================;
(setvar "CLAYER" OLDLAY)
(setvar "OSMODE" OLDSNAP)
(setvar "BLIPMODE" OLDBLIP)
(setvar "HIGHLIGHT" OLDLIGHT)
(princ)
);defun

Rob.

[CAB]

Thanks for sharing Rob.

Looks like you are working in Centimeters or Millimeters?

[Rob-GB]

Millimetres, CAB, being based in the UK it is the main unit of measure. No reason the routine could not be adapted to centimetres for those in mainland europe or Inches for those in the USA who want to draw up a euro style straight flight. 
The default settings are the most common ones I use. I hope to get a windered version of this done in the near future, even though this one could be improved, but it will save me a fair bit of drafting time.
Rob.

[Tharwat]

Nice work Rob .

I am glad to see your routine works that great 

Good luck.

Tharwat

[Mark]

Cool! I wrote one very similar (side elevation only) a few years ago for a custom stair company. If I remember correctly the math was the fun part. The finished product was sent to a CNC machine.

Code: [Select]

;;; 1)What is the tread run?
;;;
;;; 2)What is the riser height? The first riser is always 1.00" less
;;;
;;; 3)How many risers? The first riser is always 1.00" less in height than
;;; the rest of the risers(1st riser only!)


[Rob-GB]

Thanks Mark.
Tread run is also called "Going" and is the distance from face of riser to face of riser.
Riser height is left the same for all risers and is the rise plus the groove depth into the next tread, I set that to 10mm.
Bottom or first riser is left same height so that it can be scribed to the floor if retrofitted or screeded up to (which traps it into the floor) the same is usually done with string ends and newell posts.
'Nosing' is the treads projection from face of riser and is commonly bullnosed and most often the same as the tread thickness.
I am thinking of adding a text box with final dimensions for the stair all listed, rise, going,pitch etc.

Rob.

[Rob-GB]

Tharwat, it was your prod in the right direction that got me there. Thanks.

Rob.

[LE3]

Another one (metal stair . section and plan layout) per UBC code:
http://www.theswamp.org/index.php?topic=9441.msg172150#msg172150