Hi guys 'n gals,
while this site was getting an un-scheduled makeover I was writing a lisp for stairs
that I commonly have to draw up. I asked for and got help from the Swamp from people who are also members here too.
So on the grounds that other members here should get the use of the resulting lisp, should they need it, despite disruption by the sad person/s who caused it, I am posting the code here too.
Any comments about it will be gratefully received as I am on a steep learning curve!
(defun C:stairv1 (/ IP GOING RISE NOSING TRTH RITH RHT 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 TWRW TRENCH LEN ANG TXPP TXTPT TXTHT TOGO TORI TRDT DISTS 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. Updated 17.03.2011 due to assistance from Tharwat and Cab (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 :"))) (T (setq GOING GOING))))(setq RISE (cond ((getdist (strcat "\nEnter rise of step :"))) (T (setq RISE RISE))))(setq TRTH (cond ((getdist (strcat "\nEnter tread thickness :"))) (T (setq TRTH TRTH))))(setq RITH (cond ((getdist (strcat "\nEnter riser thickness :"))) (T (setq RITH RITH))))(setq WIDE (cond ((getdist (strcat "\nEnter width across strings :"))) (T (setq WIDE WIDE)))) (setq STRTH (cond ((getdist (strcat"\nEnter string thickness :"))) (T (setq STRTH STRTH))))(setq NOSING (cond ((getdist (strcat"\nEnter nosing projection :"))) (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;=========================================================================================;; Information Bar; Total Rise, Total Going, Riser Width Height, Tread Depth Length, Thick String length width thick;width across strings, tread groove width depth, Trenching depth, Pitch, point to point on pitch line (setq TORI (* STEPS RISE)) (setq TOGO (* STEPS GOING)) (setq TRDT (+ NOSING GOING)) (setq RHT (+ (- RISE GRD) TRTH)) (setq TWRW (+ RWTW (* TRENCH 2))) (setq DISTS (distance S2 S5)) ;=========================================================================================; (defun TextAdd (txt TXPP ht) (entmakex (list (cons 0 "TEXT") (cons 1 txt) ;* (the string itself) (cons 6 "BYLAYER") ; Linetype name (cons 8 (if lay lay (getvar "CLAYER"))) ; layer (cons 10 TXPP) ;* First alignment point (in OCS) (cons 40 10.0) ;* Text height;; changed to set the text height I want to use (cons 50 0.0) ; Text rotation angle (cons 71 0) ; Text generation flags (cons 72 0) ; Horizontal text justification type (cons 73 0) ; Vertical text justification type (cons 210 (list 0.0 0.0 1.0))))) ;Code Courtesy of CAB ;=========================================================================================; (setq TXTHT 10.) (setq TXPP (getpoint "\nPick the point for the Text: ")) (TextAdd (strcat "Total Rise Is:" (rtos TORI 2 2) " Total Going Is:" (rtos TOGO 2 2)) TXPP TXTHT) (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 4))) (TextAdd (strcat "Risers Are: " (rtos TWRW 2 2)" By " (rtos RHT 2 2)" By "(rtos RITH 2 2)) TXPP TXTHT) (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 4))) (TextAdd (strcat "Treads Are: "(rtos TWRW)" By "(rtos TRDT)" By "(rtos TRTH)) TXPP TXTHT) (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 4))) (TextAdd (strcat "Pitch Of Stair: " (angtos (atan RISE GOING) 0 2)" Degrees") TXPP TXTHT ) (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 4))) (TextAdd (strcat "Width Across Strings Is: " (rtos WIDE 2 2)) TXPP TXTHT) (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 4))) (TextAdd (strcat "Minimum String Length Is: " (rtos DISTS 2 2)) TXPP TXTHT) (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 4))) (TextAdd (strcat "Groove In Tread Is: " (rtos GR 2 2)"mm Deep") TXPP TXTHT) (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 4))) (TextAdd (strcat "String Housings Or Trenching Is: " (rtos TRENCH 2 2)"mm Deep") TXPP TXTHT) (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 4))) (TextAdd (strcat "Point To Point On Pitch Line Is: " (rtos LEN 2 2)"mm ") TXPP TXTHT);=========================================================================================;(setvar "CLAYER" OLDLAY)(setvar "OSMODE" OLDSNAP)(setvar "BLIPMODE" OLDBLIP)(setvar "HIGHLIGHT" OLDLIGHT)(princ));defun
Rob.