Stair section LISP - Help!
Hi everyone,I found this great and simple LISP for stair section. I wanted to add a few more options to this LISP which it won't currently let you do. Firstly I want to specify the tread width since the default is set to 11. I've managed to create a prompt for the width, but it leaves a a gap if you chose anything other than 11". Also, I'd like to be able to set a starting point for the stairs and set the max riser on it. Any thoughts?
Thank you.
(defun C:STAIRPROFILE (/ ANG CNT ELEVDIFF LOWER LOWERFLOOR LOWERFLOORPICK OSM PNTARRAY RISERHEIGHT STARTPNT UPPER UPPERFLOOR UPPERFLOORPICK PROBLEM ) (setq OSM (getvar "OSMODE")) (setvar "osmode" 0) (defun ASC (ELEMENT ENTITY /) (cdr (assoc ELEMENT ENTITY)));;; retrieve assoc data from entity (defun DTR (A) (* pi (/ A 180.0)));;; utility to convert decimal degrees to radians(setq TREADWIDTH (getdist "\nWhat tread width?: ")LOWERFLOOR (entsel "\nSelect lower floor: ")LOWERFLOORPICK (car (cdr LOWERFLOOR))LOWERFLOOR (entget (car LOWERFLOOR))UPPERFLOOR (entsel "\nSelect upper floor: ")UPPERFLOORPICK (car (cdr UPPERFLOOR))UPPERFLOOR (entget (car UPPERFLOOR))PROBLEM 0 ) (if (= (ASC 0 LOWERFLOOR) "LINE") (if (= (cadr (ASC 10 LOWERFLOOR)) (cadr (ASC 11 LOWERFLOOR))) (setq LOWER (cadr (ASC 10 LOWERFLOOR))) (setq PROBLEM 1) ) (setq PROBLEM 2) ) (if (= (ASC 0 UPPERFLOOR) "LINE") (if (= (cadr (ASC 10 UPPERFLOOR)) (cadr (ASC 11 UPPERFLOOR))) (setq UPPER (cadr (ASC 10 UPPERFLOOR))) (setq PROBLEM 3) ) (setq PROBLEM 4) ) (if (and (/= UPPER NIL) (/= LOWER NIL) (/= PROBLEM 1)) (progn (if (> UPPER LOWER)(progn(setq ELEVDIFF (- UPPER LOWER)))(progn (setq ELEVDIFF (- LOWER UPPER))) ) (setq RISERHEIGHT (/ ELEVDIFF (fix (/ ELEVDIFF 7))) STARTPNT (inters (ASC 10 LOWERFLOOR) (ASC 11 LOWERFLOOR) LOWERFLOORPICK (polar LOWERFLOORPICK (DTR 90.0) 1.0) NIL ) ) (if (> (car UPPERFLOORPICK) (car STARTPNT))(setq ANG (DTR 0.0))(setq ANG (DTR 180.0)) ) (setq PNTARRAY NIL) (repeat (fix (/ ELEVDIFF RISERHEIGHT))(if (not PNTARRAY)(setq PNTARRAY (list (polar (polar STARTPNT (DTR 90.0) RISERHEIGHT) ANG 10.0 ) ))(setq PNTARRAY (append (list (polar (polar (car PNTARRAY) (DTR 90.0) RISERHEIGHT) ANG 10.0 ) ) PNTARRAY ))) ) (setq PNTARRAY (append (list STARTPNT) (reverse PNTARRAY))) (setq CNT 0) (repeat (1- (length PNTARRAY))(CREATETREAD (nth CNT PNTARRAY) RISERHEIGHT ANG)(setq CNT (1+ CNT)) ) ) (progn (cond ((= PROBLEM 1) (setq MSG "Lower elevation not level.") ) ((= PROBLEM 2) (setq MSG (strcat "Lower level not of type " (chr 34) "LINE" (chr 34) "." ) ) ) ((= PROBLEM 3) (setq MSG "Upper elevation not level.") ) ((= PROBLEM 4) (setq MSG (strcat "Upper level not of type " (chr 34) "LINE" (chr 34) "." ) ) ) ) (alert MSG) ) ) (setvar "osmode" OSM))(defun CREATETREAD (N HEIGHT ANG /) (setq TREADHEIGHT 1.5NOSEWIDTH 1.0 ) (setq TREADPNTS (list (polar N (DTR 90.0) (- HEIGHT TREADHEIGHT)))TREADPNTS (append (list (polar (car TREADPNTS) (+ (DTR 180.0) ANG) NOSEWIDTH) ) TREADPNTS )TREADPNTS (append (list (polar (car TREADPNTS) (DTR 90.0) TREADHEIGHT)) TREADPNTS )TREADPNTS (append (list (polar (car TREADPNTS) ANG TREADWIDTH)) TREADPNTS )TREADPNTS (reverse TREADPNTS) ) (command "line" N (nth 0 TREADPNTS) (nth 1 TREADPNTS) (nth 2 TREADPNTS) (nth 3 TREADPNTS) "" )) Ok i've made a bit or progress... But I still can't figure out why any value above or below 11 messes up how the stairs are assembled. I either end up getting gaps or overlaps.
(defun C:dsp (/ ANG CNT ELEVDIFF LOWER LOWERFLOOR LOWERFLOORPICK OSM PNTARRAY RISERHEIGHT STARTPNT UPPER UPPERFLOOR UPPERFLOORPICK PROBLEM ) (setq OSM (getvar "OSMODE")) (setvar "osmode" 0) (defun ASC (ELEMENT ENTITY /) (cdr (assoc ELEMENT ENTITY)));;; retrieve assoc data from entity (defun DTR (A) (* pi (/ A 180.0)));;; utility to convert decimal degrees to radians(setq TREADWIDTH (getdist "\nWhat tread width?: ")LOWERFLOOR (entsel "\nSelect lower floor: ")LOWERFLOORPICK (car (cdr LOWERFLOOR))LOWERFLOOR (entget (car LOWERFLOOR))UPPERFLOOR (entsel "\nSelect upper floor: ")UPPERFLOORPICK (car (cdr UPPERFLOOR))UPPERFLOOR (entget (car UPPERFLOOR))PROBLEM 0 ) (if (= (ASC 0 LOWERFLOOR) "LINE") (if (= (cadr (ASC 10 LOWERFLOOR)) (cadr (ASC 11 LOWERFLOOR))) (setq LOWER (cadr (ASC 10 LOWERFLOOR))) (setq PROBLEM 1) ) (setq PROBLEM 2) ) (if (= (ASC 0 UPPERFLOOR) "LINE") (if (= (cadr (ASC 10 UPPERFLOOR)) (cadr (ASC 11 UPPERFLOOR))) (setq UPPER (cadr (ASC 10 UPPERFLOOR))) (setq PROBLEM 3) ) (setq PROBLEM 4) ) (if (and (/= UPPER NIL) (/= LOWER NIL) (/= PROBLEM 1)) (progn (if (> UPPER LOWER)(progn(setq ELEVDIFF (- UPPER LOWER)))(progn (setq ELEVDIFF (- LOWER UPPER))) ) (setq N (/ ELEVDIFF 7.75)) (setq RISERHEIGHT (/ ELEVDIFF (fix (+ N(if (minusp N) -0.5 0.5)))) STARTPNT (inters (ASC 10 LOWERFLOOR) (ASC 11 LOWERFLOOR) LOWERFLOORPICK (polar LOWERFLOORPICK (DTR 90.0) 1.0) NIL ) ) (if (> (car UPPERFLOORPICK) (car STARTPNT))(setq ANG (DTR 0.0))(setq ANG (DTR 180.0)) ) (setq PNTARRAY NIL) (repeat (fix (/ ELEVDIFF RISERHEIGHT))(if (not PNTARRAY)(setq PNTARRAY (list (polar (polar STARTPNT (DTR 90.0) RISERHEIGHT) ANG 10.0 ) ))(setq PNTARRAY (append (list (polar (polar (car PNTARRAY) (DTR 90.0) RISERHEIGHT) ANG 10.0 ) ) PNTARRAY ))) ) (setq PNTARRAY (append (list STARTPNT) (reverse PNTARRAY))) (setq CNT 0) (repeat (1- (length PNTARRAY))(CREATETREAD (nth CNT PNTARRAY) RISERHEIGHT ANG)(setq CNT (1+ CNT)) ) ) (progn (cond ((= PROBLEM 1) (setq MSG "Lower elevation not level.") ) ((= PROBLEM 2) (setq MSG (strcat "Lower level not of type " (chr 34) "LINE" (chr 34) "." ) ) ) ((= PROBLEM 3) (setq MSG "Upper elevation not level.") ) ((= PROBLEM 4) (setq MSG (strcat "Upper level not of type " (chr 34) "LINE" (chr 34) "." ) ) ) ) (alert MSG) ) ) (setvar "osmode" OSM))(defun CREATETREAD (N HEIGHT ANG /) (setq TREADHEIGHT 1.5NOSEWIDTH 1.0 ) (setq TREADPNTS (list (polar N (DTR 90.0) (- HEIGHT TREADHEIGHT)))TREADPNTS (append (list (polar (car TREADPNTS) (+ (DTR 180.0) ANG) NOSEWIDTH) ) TREADPNTS )TREADPNTS (append (list (polar (car TREADPNTS) (DTR 90.0) TREADHEIGHT)) TREADPNTS )TREADPNTS (append (list (polar (car TREADPNTS) ANG TREADWIDTH)) TREADPNTS )TREADPNTS (reverse TREADPNTS) ) (command "line" N (nth 0 TREADPNTS) (nth 1 TREADPNTS) (nth 2 TREADPNTS) (nth 3 TREADPNTS) "" )) I'm only looking at what makes the tread 11" wide here.
Where you set the variable PNTARRAY to a list in two places, change the entry "10.0" to your variable TREADWIDTH minus 1.0 (- TREADWIDTH 1.0) which I think is your NOSEWIDTH, but that's not set until later in your code.Since it's hard-coded anyway, that's what I did to get it to work...
Or, you could just rearrange the code to call the NOSEWIDTH so you could subtract it from the TREADWIDTH.
(list (polar (polar (car PNTARRAY) (DTR 90.0) RISERHEIGHT) ANG 10.0 ; make this (- TREADWIDTH 1.0) ))
Thank you! This works perfectly. Any thoughts on how to be able to chose a point in which to start the stairs? I thought about changing the (entsel) to (getpoint) but when I changed it, it didn't work. So i'm a bit over my head with it. Start by moving the (setvar "osmode" 0) below the floor variables...
(setq OSM (getvar "OSMODE")) (setvar "osmode" 0) ; move from here... (defun ASC (ELEMENT ENTITY /) (cdr (assoc ELEMENT ENTITY)));;; retrieve assoc data from entity (defun DTR (A) (* pi (/ A 180.0)));;; utility to convert decimal degrees to radians(setq TREADWIDTH (getdist "\nWhat tread width?: ") LOWERFLOOR (entsel "\nSelect lower floor: ") LOWERFLOORPICK (car (cdr LOWERFLOOR)) LOWERFLOOR (entget (car LOWERFLOOR)) UPPERFLOOR (entsel "\nSelect upper floor: ") UPPERFLOORPICK (car (cdr UPPERFLOOR)) UPPERFLOOR (entget (car UPPERFLOOR)) PROBLEM 0 ) (setvar "osmode" 0) ; to here1. Change LOWERFLOOR using GETPOINT, as you mentioned, but add NENTSELP
(nentselp (getpoint "\nSelect lower floor: "))
2. Change LOWERFLOORPICK to select the entity GETPOINT location
(cadr LOWERFLOOR)
(setq TREADWIDTH (getdist "\nWhat tread width?: ") LOWERFLOOR (entsel "\nSelect lower floor: ") ; here... LOWERFLOORPICK (car (cdr LOWERFLOOR)) ; here... LOWERFLOOR (entget (car LOWERFLOOR)) UPPERFLOOR (entsel "\nSelect upper floor: ") UPPERFLOORPICK (car (cdr UPPERFLOOR)) UPPERFLOOR (entget (car UPPERFLOOR)) PROBLEM 0 )See if that helps.
I tried what you said but I would get an error saying the selection is not a "LINE" before the program even starts running then it gives me an error.
I did a crappy work around by doing this. Notice i also fixed my round up issue.
(defun C:dss (/ ANG CNT ELEVDIFF LOWER LOWERFLOOR LOWERFLOORPICK OSM PNTARRAY RISERHEIGHT STARTPNT UPPER UPPERFLOOR UPPERFLOORPICK PROBLEM ) (setq OSM (getvar "OSMODE")) (setvar "osmode" 0) (defun ASC (ELEMENT ENTITY /) (cdr (assoc ELEMENT ENTITY)));;; retrieve assoc data from entity (defun DTR (A) (* pi (/ A 180.0)));;; utility to convert decimal degrees to radians(setq TREADWIDTH (getdist "\nWhat is tread width including nosing?: ")LOWERFLOOR (entsel "\nSelect lower floor: ")LOWERFLOORPICK (car (cdr LOWERFLOOR))LOWERFLOOR (entget (car LOWERFLOOR))UPPERFLOOR (entsel "\nSelect upper floor: ")UPPERFLOORPICK (car (cdr UPPERFLOOR))UPPERFLOOR (entget (car UPPERFLOOR))PROBLEM 0 ) (if (= (ASC 0 LOWERFLOOR) "LINE") (if (= (cadr (ASC 10 LOWERFLOOR)) (cadr (ASC 11 LOWERFLOOR))) (setq LOWER (cadr (ASC 10 LOWERFLOOR))) (setq PROBLEM 1) ) (setq PROBLEM 2) ) (if (= (ASC 0 UPPERFLOOR) "LINE") (if (= (cadr (ASC 10 UPPERFLOOR)) (cadr (ASC 11 UPPERFLOOR))) (setq UPPER (cadr (ASC 10 UPPERFLOOR))) (setq PROBLEM 3) ) (setq PROBLEM 4) ) (if (and (/= UPPER NIL) (/= LOWER NIL) (/= PROBLEM 1)) (progn (if (> UPPER LOWER)(progn(setq ELEVDIFF (- UPPER LOWER)))(progn (setq ELEVDIFF (- LOWER UPPER))) ) (setq N (/ ELEVDIFF 7.75))(defun ROUND ( n m ) (cond ((equal 0.0 (rem n m) 1e- n) ((< n 0) (- n (rem n m))) ((+ n (- m (rem n m)))) ))(setq B (ROUND N 1))(setvar "osmode" 3) (setq RISERHEIGHT (/ ELEVDIFF B) STARTPNT (getpoint "\nPick starting point: "))(setvar "osmode" 0) (setq ans (getstring "\nIs stair going left or right bound? L/R"))(if (= (strcase ans) "R")(setq ANG (DTR 0.0))(setq ANG (DTR 180.0)) ) (setq PNTARRAY NIL) (repeat (fix (/ ELEVDIFF RISERHEIGHT))(if (not PNTARRAY)(setq PNTARRAY (list (polar (polar STARTPNT (DTR 90.0) RISERHEIGHT) ANG (- TREADWIDTH 1.0) ) ))(setq PNTARRAY (append (list (polar (polar (car PNTARRAY) (DTR 90.0) RISERHEIGHT) ANG (- TREADWIDTH 1.0) ) ) PNTARRAY ))) ) (setq PNTARRAY (append (list STARTPNT) (reverse PNTARRAY))) (setq CNT 0) (repeat (1- (length PNTARRAY))(CREATETREAD (nth CNT PNTARRAY) RISERHEIGHT ANG)(setq CNT (1+ CNT)) ) ) (progn (cond ((= PROBLEM 1) (setq MSG "Lower elevation not level.") ) ((= PROBLEM 2) (setq MSG (strcat "Lower level not of type " (chr 34) "LINE" (chr 34) "." ) ) ) ((= PROBLEM 3) (setq MSG "Upper elevation not level.") ) ((= PROBLEM 4) (setq MSG (strcat "Upper level not of type " (chr 34) "LINE" (chr 34) "." ) ) ) ) (alert MSG) ) ) (setvar "osmode" OSM))(defun CREATETREAD (N HEIGHT ANG /) (setq TREADHEIGHT 1.5NOSEWIDTH 1.0 ) (setq TREADPNTS (list (polar N (DTR 90.0) (- HEIGHT TREADHEIGHT)))TREADPNTS (append (list (polar (car TREADPNTS) (+ (DTR 180.0) ANG) NOSEWIDTH) ) TREADPNTS )TREADPNTS (append (list (polar (car TREADPNTS) (DTR 90.0) TREADHEIGHT)) TREADPNTS )TREADPNTS (append (list (polar (car TREADPNTS) ANG TREADWIDTH)) TREADPNTS )TREADPNTS (reverse TREADPNTS) ) (command "line" N (nth 0 TREADPNTS) (nth 1 TREADPNTS) (nth 2 TREADPNTS) (nth 3 TREADPNTS) "" ))(defun *error* (msg)(cond ((not msg)) ; Normal exit((member msg '("Function cancelled" "quit / exit abort"))) ;or (quit)((princ (strcat "\nError: " msg "")) ; Fatal error, display it(cond ((vl-bb-ref '*Debug*) (vl-bt))))) ; If in debug mode, dump backtrace(setvar 'OSMODE OSM) (princ)) Huh...not sure what went wrong - it works for me in BricsCAD, but I'm glad you got it to work!
From what I can tell, this is causing the issue.
(if (= (ASC 0 LOWERFLOOR) "LINE") (if (= (cadr (ASC 10 LOWERFLOOR)) (cadr (ASC 11 LOWERFLOOR))) (setq LOWER (cadr (ASC 10 LOWERFLOOR))) (setq PROBLEM 1) ) (setq PROBLEM 2) ) (if (= (ASC 0 UPPERFLOOR) "LINE") (if (= (cadr (ASC 10 UPPERFLOOR)) (cadr (ASC 11 UPPERFLOOR))) (setq UPPER (cadr (ASC 10 UPPERFLOOR))) (setq PROBLEM 3)
((= PROBLEM 2) (setq MSG (strcat "Lower level not of type " (chr 34)
I tried deleting the PROBLEMs but it was giving me trouble. So i don't know. What I have isn't glorious but its working for the time being. Unless someone is kind enough to rewrite it anyways Just checkin' with you - both of the lines you're selecting are LINES and not PLINES, right?Weird...
Yes. Infact, this error popped up before I could even select anything. However, I do think I did something wrong.
So here's the code I think we have in similar. This is not the latest and greatest, but more likely the one with have in common
(defun C:DSP (/ ANG CNT ELEVDIFF LOWER LOWERFLOOR LOWERFLOORPICK OSM PNTARRAY RISERHEIGHT STARTPNT UPPER UPPERFLOOR UPPERFLOORPICK PROBLEM ) (setq OSM (getvar "OSMODE")) (defun ASC (ELEMENT ENTITY /) (cdr (assoc ELEMENT ENTITY)));;; retrieve assoc data from entity (defun DTR (A) (* pi (/ A 180.0)));;; utility to convert decimal degrees to radians(setq TREADWIDTH (getdist "\nWhat tread width?: ")LOWERFLOOR (nentselp (getpoint "\nSelect lower floor: "))LOWERFLOORPICK (car (cdr LOWERFLOOR))LOWERFLOOR (nentselp (cadr LOWERFLOOR))UPPERFLOOR (entsel "\nSelect upper floor: ")UPPERFLOORPICK (car (cdr UPPERFLOOR))UPPERFLOOR (entget (car UPPERFLOOR))PROBLEM 0 ) (setvar "osmode" 0) (if (= (ASC 0 LOWERFLOOR) "LINE") (if (= (cadr (ASC 10 LOWERFLOOR)) (cadr (ASC 11 LOWERFLOOR))) (setq LOWER (cadr (ASC 10 LOWERFLOOR))) (setq PROBLEM 1) ) (setq PROBLEM 2) ) (if (= (ASC 0 UPPERFLOOR) "LINE") (if (= (cadr (ASC 10 UPPERFLOOR)) (cadr (ASC 11 UPPERFLOOR))) (setq UPPER (cadr (ASC 10 UPPERFLOOR))) (setq PROBLEM 3) ) (setq PROBLEM 4) ) (if (and (/= UPPER NIL) (/= LOWER NIL) (/= PROBLEM 1)) (progn (if (> UPPER LOWER)(progn(setq ELEVDIFF (- UPPER LOWER)))(progn (setq ELEVDIFF (- LOWER UPPER))) ) (setq N (/ ELEVDIFF 7.75)) (setq RISERHEIGHT (/ ELEVDIFF (fix (+ N(if (minusp N) -0.5 0.5)))) STARTPNT (inters (ASC 10 LOWERFLOOR) (ASC 11 LOWERFLOOR) LOWERFLOORPICK (polar LOWERFLOORPICK (DTR 90.0) 1.0) NIL ) ) (if (> (car UPPERFLOORPICK) (car STARTPNT))(setq ANG (DTR 0.0))(setq ANG (DTR 180.0)) ) (setq PNTARRAY NIL) (repeat (fix (/ ELEVDIFF RISERHEIGHT))(if (not PNTARRAY)(setq PNTARRAY (list (polar (polar STARTPNT (DTR 90.0) RISERHEIGHT) ANG 10.0 ) ))(setq PNTARRAY (append (list (polar (polar (car PNTARRAY) (DTR 90.0) RISERHEIGHT) ANG 10.0 ) ) PNTARRAY ))) ) (setq PNTARRAY (append (list STARTPNT) (reverse PNTARRAY))) (setq CNT 0) (repeat (1- (length PNTARRAY))(CREATETREAD (nth CNT PNTARRAY) RISERHEIGHT ANG)(setq CNT (1+ CNT)) ) ) (progn (cond ((= PROBLEM 1) (setq MSG "Lower elevation not level.") ) ((= PROBLEM 2) (setq MSG (strcat "Lower level not of type " (chr 34) "LINE" (chr 34) "." ) ) ) ((= PROBLEM 3) (setq MSG "Upper elevation not level.") ) ((= PROBLEM 4) (setq MSG (strcat "Upper level not of type " (chr 34) "LINE" (chr 34) "." ) ) ) ) (alert MSG) ) ) (setvar "osmode" OSM))(defun CREATETREAD (N HEIGHT ANG /) (setq TREADHEIGHT 1.5NOSEWIDTH 1.0 ) (setq TREADPNTS (list (polar N (DTR 90.0) (- HEIGHT TREADHEIGHT)))TREADPNTS (append (list (polar (car TREADPNTS) (+ (DTR 180.0) ANG) NOSEWIDTH) ) TREADPNTS )TREADPNTS (append (list (polar (car TREADPNTS) (DTR 90.0) TREADHEIGHT)) TREADPNTS )TREADPNTS (append (list (polar (car TREADPNTS) ANG TREADWIDTH)) TREADPNTS )TREADPNTS (reverse TREADPNTS) ) (command "line" N (nth 0 TREADPNTS) (nth 1 TREADPNTS) (nth 2 TREADPNTS) (nth 3 TREADPNTS) "" ))
With this code I get the following error after I select the ground floor point:
Select upper floor:
Error: bad association list: ( (2180.67 -22506.0 0.0))
页:
[1]
2