(defun str_err (msg)

(if (/= msg nil)
(progn
(princ (strcat "nError: " msg )) (princ)
(str_normex)
(str_varnil)
) ;progn
) ;if
) ;defun

;;;----------------------------------------------------------------------------;;;

;-> resets ACAD variables (normal exit)

(defun str_normex ()

(setvar "lunits" slun)
(setvar "luprec" slprec)
(setvar "osmode" sosm)
(setvar "plinewid" splw)
(setvar "cmdecho" scmd)
(setvar "textsize" stxtsz)
(setq *error* old_error)
(setq old_error nil)

) ;defun

;;;---------------------------------------------------------------------------;;;

;-> set all stairs.lsp variables to nil

(defun str_varnil ()

(foreach varlst '(ff th apx dvsr tavg mintrd midtrd maxtrd
nzh nzl slun slprec sosm splw nor lft rt dn
rht trdflt tsiz tdir nostp step nostp rnded
dflts pt1 pt2 pt3 pt4 pt5 strshp scmd ang
dist horiz botris stxtsz txtpt prntxt)
(set varlst nil)
) ;foreach
(princ)
) ;defun

;;;---------------------------------------------------------------------------;;;

;-> define math functions

(defun dtr (a)
(* pi (/ a 180.0))
)

(defun tan (a)
(/ (sin a) (cos a))
)

(defun rnd (n / fn sfn)
(setq fn (fix n))
(setq sfn (- n fn))
(if (>= sfn 0.5)
(setq n (+ fn 1))
(setq n fn)
) ;if
) ; defun

;;;---------------------------------------------------------------------------;;;


(defun str_setup ()

;-> set variables

(str_varnil) ;-> set stairs.lsp variables to nil
(setq old_error *error* ;-> trap old error handler
*error* str_err) ;-> set error handler
(setq slun (getvar "lunits"))
(setvar "lunits" 2 ;-> decimal
)
(setq slprec (getvar "luprec"))
(setvar "luprec" 4 ;-> four decimal places
)
(setq splw (getvar "plinewid"))
(setvar "plinewid" 0.0 ;-> set polyline width
)
(setq sosm (getvar "osmode")
)
(setq scmd (getvar "cmdecho"))
(setvar "cmdecho" 0 ;-> set cmdecho off
)
(setq stxtsz (getvar "textsize"))
(setvar "textsize" 6 ;-> set textsize to 6
)

) ;defun

;;;---------------------------------------------------------------------------;;;

;-> call other info functions

(defun str_info ()

(str_ht) ;1
(str_dir) ;2
(str_shp) ;3
(str_default) ;4
(str_ris_ht) ;5
(str_trd_siz) ;6
(str_trd_th) ;7
(str_nozlen) ;8

);defun

;;;---------------------------------------------------------------------

;->determine total height #1 from info

(defun str_ht ( / ff) ;-> first floor

(princ "nDetermine Overall Height...")
(setvar "osmode" 512) ;-> set osnap to nearest
(initget 9)
(setq ff (getpoint "nPick Any Point On The Lower Level: "))
(setvar "osmode" 33)
(initget 9)
(setq pt1 (getpoint "nPick The Top Step: "))
(setq th (-(cadr pt1)(cadr ff)))
(setq txtpt (polar pt1 (/ pi 2.0) 36))

);defun

;;;-------------------------------------------------------------------------

;->determine stair direction #2 from info

(defun str_dir ()

(princ "nDetermine Stair Direction...")
(initget 1 "Left Right")
(setq tdir (getkword "nStairs Go Down To Right or Left? (R or L) "))
(if (= (substr tdir 1 1) "R")
(setq tdir nil)
(setq tdir 1)
) ;if
) ;defun

;;;---------------------------------------------------------------------

;->determine stair shape #3 from info

(defun str_shp ()

(princ "nDetermine Nosing Shape...")
(initget 7 "Square Round")
(setq strshp (getkword "nDo You Want Square Or Round Nose? (S or R) "))
(if (= (substr strshp 1 1) "S")
(setq strshp nil)
(setq strshp 1)
) ;if
) ;defun

;;;-------------------------------------------------------------------------;;;

;->accept defaults or customize #4 from info

(defun str_default ()

(princ "nSelect Design Method...")
(initget 6 "Customize Defaults")
(setq dflts (getkword "nCustomize or Defaults (C or D) <Defaults>"))
(if (or
(= dflts nil)
(= (substr dflts 1 1) "D")
) ;or
(setq dflts 1)
(setq dflts nil)
) ;if
) ;defun

;;;-------------------------------------------------------------------------;;;

;->determine riser height #5 from info

(defun str_ris_ht ( / dvsr ;->desired riser height (divisor)
apx
rnded) ;->rounded apx

(princ "nDetermine Riser Height...")
(if dflts
(progn ;then
(setq nor (rnd (/ th 7)))
(setq rht (/ th nor))
) ;progn then
(progn ;else
(initget 6)
(setq dvsr (getreal (strcat
"nDesired Riser Height Is: <7"> " )))
(if (= dvsr nil) (setq dvsr 7)
) ;if
(setq apx(/ th dvsr))
(princ (strcat
"nTotal Height Divided By " (rtos dvsr 4 4) " is: " (rtos apx))
) ;princ
(setq rnded (rnd apx))
(initget 6)
(setq nor (getint (strcat
"nHow Many Risers Do You Want?: <"(itoa rnded)"> ")))
(if (= nor nil) (setq nor rnded)
) ;if
(setq rht (/ th nor))
(princ (strcat "nRiser Height Is: " (rtos rht 5 5) """))
) ;progn else
) ;if
) ;defun

;;;------------------------------------------------------------------------

;->determine tread size #6 from info

(defun str_trd_siz ( / horiz ;-> horizontal constraints y or n
botris ;-> point for bottom riser
tavg ;-> average of first three tests
mintrd ;-> tread size @ 35 degrees
midtrd ;-> " " @ 32.5 "
maxtrd ;-> " " @ 30 "
trdflt) ;-> default tread size

;->if constrained horizontally, set tread size to fit

(princ "nDetermine Tread And Nosing Size...")
(if (not dflts) ;customize
(progn ;then
(initget 6 "Yes No")
(setq horiz (getkword
"nHorizontal Constraints? (Y or N): <N>"))
(if (or
(= horiz nil)
(= (substr horiz 1 1) "N")
) ;or
(setq horiz nil)
(setq horiz 1)
) ;if
) ;progn then
) ;if not dflts

(if horiz
(progn ;then
(setvar "osmode" 33)
(initget 9)
(setq botris (getpoint "nPick Point For Bottom Riser:"))
(setq tsiz (abs (/ (- (car pt1) (car botris)) (- nor 1))))
) ;progn then

;->first three rules of stairs average

(progn ;else
(setq tavg (/ (+ (- 17.25 rht) (- 24.5 rht) (/ 72.5 rht)) 3))

;->test for angle of stairs and set tread size default

(setq mintrd (/ rht (tan (dtr 35))))
(setq midtrd (/ rht (tan (dtr 32.5))))
(setq maxtrd (/ rht (tan (dtr 30))))
(if (and
(>= tavg mintrd)
(<= tavg maxtrd)
) ;and
(setq trdflt tavg)
(setq trdflt midtrd)
) ;if
(if dflts
(setq tsiz trdflt) ;then
(progn ;else

;->display range of tread sizes for 30-35 degree stair

(princ "nFor Stair Between 30 and 35 Degrees...")
(princ (strcat
"nTread Should Be: " (rtos mintrd 5 4) "" to " (rtos maxtrd 5 4) """)
) ;princ
(initget 6)
(setq tsiz (getreal (strcat
"nEnter Tread Size In Inches: <" (rtos trdflt 5 4) "">")))
(if (= tsiz nil) (setq tsiz trdflt)
) ;if
) ;progn else
) ;if dflts
) ;progn
) ;if horiz

;->display angle of stairs

(princ (strcat
"nAngle Of Stairs Is: " (angtos (atan rht tsiz) 0 2) " Degrees")
) ;princ

) ;defun

;;;---------------------------------------------------------------------------;;;

;->determine tread thickness #7 from info

(defun str_trd_th ()

(if (and
(= dflts 1)
(not strshp)
) ;and
(setq nzh 1.5)
) ;if

(if (and
(not dflts)
(not strshp)
) ;and
(progn ;then
(initget 4)
(setq nzh (getreal (strcat
"nEnter Tread Thickness In Inches: <1 1/2"> ")))
(if (= nzh nil) (setq nzh 1.5))
) ;progn then
) ;if

(if (and
(= dflts 1)
(= strshp 1)
) ;and
(setq nzh 1.25)
) ;if

(if (and
(not dflts)
(= strshp 1)
) ;and
(progn ;then
(initget 6)
(setq nzh (getreal (strcat
"nEnter Tread Thickness In Inches: <1 1/4"> ")))
(if (= nzh nil) (setq nzh 1.25))
) ;progn then
) ;if
) ;defun

;;;--------------------------------------------------------------------------

;->determine nosing overhang #8 from info

(defun str_nozlen ()

(if dflts
(setq nzl 1.25) ;then
(progn ;else
(if (and
(not dflts)
(not strshp)
) ;and
(initget 4)
) ;if
(if (and
(not dflts)
(= strshp 1)
) ;and
(initget 6)
) ;if
(setq nzl (getreal (strcat
"nEnter Nosing Overhang In Inches: <1 1/4"> ")))
(if (= nzl nil) (setq nzl 1.25)
) ;if
) ;progn else
) ;if dflts
) ;defun

;;;--------------------------------------------------------------------------

;-> draw steps

(defun str_draw ( / pt2 ;->points for polylines
pt3 ;-> " " "
pt4 ;-> " " "
pt5 ;-> " " "
lft ;-> left for polar
rt ;-> right "
dn ;-> dn "
ang ;-> angle "
dist ;-> distance "
nostp ;-> counter for while loop
step) ;-> entity to copy

(if (not tdir)
(progn ;then
(setq rt 0.0)
(setq lft pi)
) ;progn
(progn ;else
(setq rt pi)
(setq lft 0.0)
) ;progn
) ;if
(setq dn (* pi 1.5))
(if strshp (setq nzl (- nzl (* nzh 0.5))) ;->subtract radius
) ;if ; from nosing
(setvar "osmode" 0) ;-> set osnap to none
(setq pt2 (polar pt1 rt nzl))
(setq pt3 (polar pt2 dn nzh))
(setq pt4 (polar pt3 lft nzl))
(if (not strshp)
(command "pline" pt1 pt2 pt3 pt4 "")
(command "pline" pt1 pt2 "a" pt3 "l" pt4 "")
) ;if
(setq pt1 (polar pt1 dn rht))
(setq pt2 (polar pt1 rt (+ tsiz nzl)))
(setq pt3 (polar pt2 dn nzh))
(setq pt4 (polar pt3 lft nzl))
(setq pt5 (polar pt4 dn (- rht nzh)))
(if (not strshp)
(command "pline" pt1 pt2 pt3 pt4 pt5 "")
(command "pline" pt1 pt2 "a" pt3 "l" pt4 pt5 "")
) ;if
(setq ang (angle pt1 pt5))
(setq dist (distance pt1 pt5))
(setq nostp (- nor 2)) ;-> set counter for while loop
(while (>= nostp 1)
(setq step (entlast))
(setq pt1 pt5)
(setq pt5 (polar pt1 ang dist))
(command "copy" step "" pt1 pt5)
(setq nostp (1- nostp))
) ;while
) ;defun

;;;---------------------------------------------------------------------------;;;

;->display properties of stairs at command line and prompt if you
;->want to print that information on the drawing.

(defun str_display ( / prntxt)

(initget "Yes No")
(setq prntxt (getkword
"nPrint Stair Dimensions On Drawing? (Y or N) <Y>"))
(if (or
(= prntxt nil)
(= prntxt "Yes")
) ;or
(setq prntxt 1)
) ;if

(if (= prntxt 1)
(progn
(if (= (cdr (assoc 40 (tblsearch "style" ;if no fixed
(getvar "textstyle")))) 0.0) ;text height
(command "text" txtpt "" "" ;then
(strcat "Overall Height Is: " (rtos th 4 4)))
(command "text" txtpt "" ;else
(strcat "Overall Height Is: " (rtos th 4 4)))
) ;if
(command "text" ""
(strcat (itoa nor)" Risers @ "(rtos rht 5 5)"""))
(command "text" ""
(strcat (itoa (- nor 1))" Treads @ "(rtos tsiz 5 4)"""))
(command "text" ""
(strcat "Angle is: " (angtos (atan rht tsiz) 0 2)" Degrees"))
) ;progn
) ;if

(princ (strcat
"nOverall Height Is: "(rtos th 4 4)))
(princ (strcat
"n"(itoa nor) " Risers @ "(rtos rht 5 5)"" " ))
(princ (strcat
(itoa (- nor 1)) " Treads @ "(rtos tsiz 5 4)"" "))
(princ (strcat
"Angle is "(angtos (atan rht tsiz) 0 2) " Degrees"))

) ;defun

;;;---------------------------------------------------------------------------;;;

;-> defines ACAD command "stairs"

(defun c:stairs ( / slun ;-> trap lunits
slprec ;-> trap lunits precision
sosm ;-> trap osnap setting
splw ;-> trap plinewidth
scmd ;-> trap cmdecho
stxtsz ;-> trap textsize
nor ;-> number of risers
rht ;-> riser height
tsiz ;-> tread size
nostp ;-> number of steps
strshp ;-> stair shape (round or square nose)
th ;-> total height
pt1 ;-> top step
txtpt ;-> point for text on drawing
tdir ;-> stair direction
dflts ;-> defaults or customize flag
nzh ;-> nosing height (tread thickness)
nzl) ;-> nosing overhang length

(prompt "nStairs.lsp by DETOUR (C) Copyright By Dan E. Thomas 1997")
(str_setup)
(str_info)
(str_draw)
(str_display)
(str_normex)
(princ)

) ;defun
(PRINC "--> 'cizimokulu.com' Çizim yardımları yüklendi !")