;|
Straight-Flight Quarter-Turn Half-Turn
08 October 2016
by Songkhran Jongkul
|;
(defun Stair ()
(setq old_cmdecho (getvar "cmdecho"))
(setq old_osnap (getvar
"osmode"))
(setq old_snap (getvar "snapmode"))
(setq old_ortho (getvar
"orthomode"))
(setq old_layer (getvar
"clayer"))
(setq old_tstyle (getvar
"textstyle"))
(setq txts (getvar
"textsize"))
(setq old_error *error*)
(setq *error* my_error )
(defun my_error (msg)
(if
(or
(= msg "Function
cancelled")
(= msg "quit / exit
abort")
)
(princ)
(princ (strcat "\nError: " msg))
)
(if msg (Alert (strcat "\nApplication error:
" msg)))
(setq *error* old_error)
(setvar "cmdecho" old_cmdecho)
(setvar "osmode" old_osnap)
(setvar "snapmode" old_snap)
(setvar "orthomode" old_ortho)
(setvar "clayer" old_layer)
(princ)
);;end my_error
(defun rtd (x) ;radial to degee
(/ (* x 180) pi)
)
(defun dtr (x) ;degee to radial
(* x (/ pi 180))
)
(defun tan (x)
(/ (sin x)(cos x))
)
(defun arsin (x)
(setq y (sqrt (- 1 (* x x))))
(atan x y)
)
(defun arcos (x)
(- (/ pi 2)(arsin x))
)
(setvar
"cmdecho" 0)
(setvar "osmode"
0)
(setvar
"snapmode" 0)
(setvar
"orthomode" 0)
(setvar
"textstyle" "Standard")
(initget "Straight-Flight Quarter-Turn
Half-Turn")
(setq ty (getkword "แบบบันได
ตรง มุมฉาก หักกลับ : [Straight-Flight/Quarter-Turn/Half-Turn] :
<Straight-Flight>"))
(if (= ty "") (setq ty
"Straight-Flight"))
(if (= ty "Straight-Flight")
(progn
(setq hi (getdist "\nความสูงระหว่างชั้น (floor
to floor hight < 3.00): <2.50>"))
(if (not hi) (setq hi 2.50))
)
)
(if (or(= ty "Quarter-Turn")(= ty
"Half-Turn"))
(progn
(setq hi (getdist "\nความสูงระหว่างชั้น (floor
to floor hight): <3.50>"))
(if (not hi) (setq hi 3.50))
)
)
(setq ws (getdist "\nความกว้างบันได
(Stair Width min. 0.80): <1.00>"))
(if (not ws) (setq ws 1.00))
(setq ri (getdist "\nลูกนอน (Riser
Width0 0.25-0.30): <0.25>"))
(if (not ri) (setq ri 0.25))
(setq tr (getdist "\nลูกตั้ง (Tread
Height 0.15-0.20): <0.15>"))
(if (not tr) (setq tr 0.15))
;(setq nos (getdist "\nลูกตั้ง
(Nosing 0.025): <0.025>"))
;(if (not nos) (setq nos 0.025))
(initget 1)
(setq pa (getpoint "\n Pick Start Stair :
"))
(setvar "Orthomode" 1)
(initget 1)
(setq pb (getpoint pa "\n Pick Angle Stair :
"))
(setvar "Orthomode" 0)
(setq ang (angle pA pB))
(setq ang1 (+ ang (DTR 90.0)))
(setq ang2 (+ ang (DTR 180.0)))
(setq ang3 (+ ang (DTR 270.0)))
(if (= ty "Straight-Flight")
(progn
(setq nums (fix(/ hi tr)))
;;step hight
(setq his (/ hi nums))
;(setq wst (+ ri nos))
(setq ts (/ (* (1+ nums) ri) 20))
(setq p1
pa
p2 (polar p1 ang3 ws)
p1a p1
p2a p2
)
(repeat (1+ nums)
(command "_line"
p1 p2 "")
(setq p1 (polar
p1 ang ri)
p2 (polar p2 ang ri)
)
);;repeat
(setq p1b
(polar p1 ang2 ri)
p2b (polar p2 ang2 ri)
)
(command "_line"
p1a p1b ""
"_line" p2a p2b ""
)
;;----------------side
view------------------------------------
(setq ps (getpoint
"\n Pick Side View Stair : "))
(setq ps1
ps
ps2 (polar ps1 (dtr 90) his)
ps3 (polar ps2 (dtr 0) ri)
)
(setq ang4 (angle
ps1 ps3)
ts1 (/ ts (cos ang4))
ts2 (* ts1
(tan (dtr(- 180 (+ 90 (rtd ang4))))))
)
(repeat nums ;(1+ nums)
(command
"_pline" ps1 ps2 ps3 "")
(setq ps1
ps3
ps2 (polar ps3 (dtr 90) his)
ps3 (polar ps2 (dtr 0) ri)
)
);;repeat
(setq ps1 (polar
ps1 (angle ps3 ps1)(sqrt
(+(expt ri 2)(expt his 2)))))
(setq ps1a
(polar ps (+ (angle ps3 ps1) (DTR 90)) ts1)
ps1b (polar ps1 (dtr 0) ts2)
)
(command "_line"
ps1a ps1b "")
);progn
);if
;;--------------Quarter-Turn--------------------------
(if (= ty "Quarter-Turn")
(progn
(setq qs ws)
(initget 1)
(setvar
"Orthomode" 1)
(setq pc (getpoint pb
"\n Pick Landing Angle : "))
(setvar
"Orthomode" 0)
(setq ang4 (angle
pb pc))
(setq hisp (/ hi 2.0))
(setq nums (fix(/ hisp
tr))) ;;step hight
(setq his (/ hisp nums))
;(setq wst (+ ri nos))
(setq ts (/ (* (1+ nums) ri) 20))
(setq p1 (polar
pa ang1 (/ ws 2.0))
p2 (polar p1 ang3 ws)
p1a p1
p2a p2
)
(repeat (1+ nums)
(command "_line"
p1 p2 "")
(setq p1 (polar
p1 ang ri)
p2 (polar p2 ang ri)
)
);;repeat
(setq p1b
(polar p1 ang2 ri)
p2b (polar p2 ang2 ri)
pa (polar
p1b ang3 (/ ws 2.0))
)
(command "_line"
p1a p1b ""
"_line" p2a p2b ""
)
;;------Quarter
Space---------
(setq qs1
p1b
qs2 p2b
qs3 (polar qs2 ang qs)
qs4 (polar qs1 ang qs)
)
(command
"_rectang" qs1 qs3)
;;------Upper
Flight----------
(setq pa (polar pa ang (/
ws 2.0))
pa1 (polar pa ang4 (/ ws 2.0))
p1 (polar pa1 (+ ang4 (DTR 90.0)) (/ ws
2.0))
p2 (polar pa1 (+ ang4 (DTR 270.0)) (/ ws
2.0))
p1a p1
p2a p2
)
(repeat (1+ nums)
(command "_line"
p1 p2 "")
(setq p1 (polar
p1 ang4 ri)
p2 (polar p2 ang4 ri)
)
);;repeat
(setq p1b
(polar p1 (+ ang4 (DTR 180.0))
ri)
p2b (polar p2 (+ ang4 (DTR 180.0)) ri)
)
(command "_line"
p1a p1b ""
"_line" p2a p2b ""
)
;;----------------side
view------------------------------------
(if (or(= ang (dtr 90))(= ang
(dtr 270)))
(progn
(setq ps (getpoint
"\n Pick Side View Stair : "))
(setq ps1 (polar
ps (dtr 180) (/ ws 2.0))
ps2 (polar ps (dtr 0) (/ ws 2.0))
ps1a ps1
ps2a ps2
)
;(setq ang4
(angle ps1 ps3)
; ts1 (/ ts
(cos ang4))
; ts2 (* ts1 (tan (dtr(- 180 (+ 90 (rtd ang4))))))
;)
(repeat (1+ nums)
(command "_line"
ps1 ps2 "")
(setq ps1 (polar
ps1 (dtr 90) his)
ps2 (polar ps2 (dtr 90) his)
)
);;repeat
(setq ps1b
(polar ps1 (DTR 270) his)
ps2b (polar ps2 (dtr 270) his)
)
(command "_line"
ps1a ps1b ""
"_line" ps2a ps2b ""
)
;;------Upper Flight---------
(setq ps (polar ps (dtr 90) (* his nums))
ps1 (polar ps ang4 (/ ws 2.0))
ps2 (polar ps1 (dtr 90) his)
ps3 (polar ps2 ang4 ri)
ps1a ps1
)
(setq ang5 (angle
ps1 ps3)
ts (/(* ri nums) 20)
ts1 (/ ts (cos ang5))
ts2 (* ts1
(tan (dtr(- 180 (+ 90 (rtd ang5))))))
)
(repeat nums ;(1+ nums)
(command
"_pline" ps1 ps2 ps3 "")
(setq ps1
ps3
ps2 (polar ps1 (dtr 90) his)
ps3 (polar ps2 ang4 ri)
)
);;repeat
(setq ps1 (polar
ps1 (angle ps3 ps1)(sqrt
(+(expt ri 2)(expt his 2)))))
(setq ps1b
(polar ps1a (+ (angle ps3 ps1) (DTR 90)) ts1)
ps1c (polar ps1 ang4 ts2)
)
(command "_line"
ps1b ps1c "")
)
)
(if (or(= ang (dtr 0))(= ang
(dtr 180)))
(progn
(setq ps (getpoint
"\n Pick Side View Stair : "))
(setq ;ps (polar ps (dtr 90) (* his nums))
ps1 ps ;(polar ps ang4 (/ ws 2.0))
ps2 (polar ps1 (dtr 90) his)
ps3 (polar ps2 ang ri)
ps1a ps1
)
(setq ang5 (angle
ps1 ps3)
ts (/(* ri nums) 20)
ts1 (/ ts (cos ang5))
ts2 (* ts1
(tan (dtr(- 180 (+ 90 (rtd ang5))))))
)
(repeat nums ;(1+ nums)
(command
"_pline" ps1 ps2 ps3 "")
(setq ps1
ps3
ps2 (polar ps1 (dtr 90) his)
ps3 (polar ps2 ang ri)
)
);;repeat
(setq ps1 (polar
ps1 (angle ps3 ps1)(sqrt
(+(expt ri 2)(expt his 2)))))
(setq ps1b
(polar ps1a (+ (angle ps3 ps1) (DTR 90)) ts1)
ps1c (polar ps1 ang ts2)
)
(command "_line"
ps1b ps1c "")
(setq ps1 (polar
ps3 (angle ps3 ps1)(sqrt
(+(expt ri 2)(expt his 2))))
ps2 (polar ps1 ang ws)
ps1a ps1
ps2a ps2
)
(repeat (1+ nums)
(command "_line"
ps1 ps2 "")
(setq ps1 (polar
ps1 (dtr 90) his)
ps2 (polar ps2 (dtr 90) his)
)
);;repeat
(setq ps1b
(polar ps1 (DTR 270) his)
ps2b (polar ps2 (dtr 270) his)
)
(command "_line"
ps1a ps1b ""
"_line" ps2a ps2b ""
)
)
)
);progn
);if Quarter-Turn
;;--------------Half-Turn--------------------------
(if (= ty "Half-Turn")
(progn
(setq qs ws)
(initget 1)
(setvar
"Orthomode" 1)
(setq pc (getpoint pb
"\n Pick Landing Angle : "))
(initget 1)
(setq pd (getpoint pc
"\n Pick Upper Flight : "))
(setvar
"Orthomode" 0)
(setq ang4 (angle
pb pc))
(setq ang4a
(angle pc pd))
(setq hisp (/ hi 2.0))
(setq nums (fix(/ hisp
tr))) ;;step hight
(setq his (/ hisp nums))
;(setq wst (+ ri nos))
(setq ts (/ (* (1+ nums) ri) 20))
(setq p1 (polar
pa ang1 (/ ws 2.0))
p2 (polar p1 ang3 ws)
p1a p1
p2a p2
)
(repeat (1+ nums)
(command "_line"
p1 p2 "")
(setq p1 (polar
p1 ang ri)
p2 (polar p2 ang ri)
)
);;repeat
(setq p1b
(polar p1 ang2 ri)
p2b (polar p2 ang2 ri)
pa (polar
pa ang (* nums ri))
qsa pa
)
(command "_line"
p1a p1b ""
"_line" p2a p2b ""
)
;;------Quarter
Space---------
;(if (or(= ang (rtd 0))(= ang (rtd 90)))(setq qs1
(polar pa ang1 (/ ws 2.0))))
;(if (> ang (rtd 0))(setq qs1 (polar qsa ang3
(/ ws 2.0))))
(setq qs1 (polar
qsa ang1 (/ ws 2.0))
qs2 (polar qs1 ang4 (* ws 2.0))
qs3 (polar qs2 ang qs)
qs4 (polar qs1 ang qs)
)
(command
"_rectang" qs1 qs3)
;;------Upper
Flight----------
(setq pa (polar pa ang4 ws)
;pa1 (polar pa ang4 (/ ws 2.0))
p1 (polar pa (+ ang4a (DTR 90.0)) (/ ws 2.0))
p2 (polar pa (+ ang4a (DTR 270.0)) (/ ws 2.0))
p1a p1
p2a p2
)
(repeat (1+ nums)
(command "_line"
p1 p2 "")
(setq p1 (polar
p1 ang4a ri)
p2 (polar p2 ang4a ri)
)
);;repeat
(setq p1b
(polar p1 (+ ang4a (DTR 180.0)) ri)
p2b (polar p2 (+ ang4a (DTR 180.0)) ri)
)
(command "_line"
p1a p1b ""
"_line" p2a p2b ""
)
;;-------------Side View----------
(if (or(= ang (dtr 0))(= ang
(dtr 180)))
(progn
(setq ps (getpoint
"\n Pick Side View Stair : "))
(setq ;ps (polar ps (dtr 90) (* his nums))
ps1 ps ;(polar ps ang4 (/ ws 2.0))
ps2 (polar ps1 (dtr 90) his)
ps3 (polar ps2 ang ri)
ps1a ps1
)
(setq ang5 (angle
ps1 ps3)
ts (/(* ri nums) 20)
ts1 (/ ts (cos ang5))
ts2 (* ts1
(tan (dtr(- 180 (+ 90 (rtd ang5))))))
)
(repeat nums ;(1+ nums)
(command
"_pline" ps1 ps2 ps3 "")
(setq ps1
ps3
ps2 (polar ps1 (dtr 90) his)
ps3 (polar ps2 ang ri)
)
);;repeat
(setq qs1
ps1
qs2 (polar qs1 ang ws)
qs3 (polar qs2 (dtr 270) his)
)
(setq ps1 (polar
ps1 (angle ps3 ps1)(sqrt
(+(expt ri 2)(expt his 2)))))
(setq ps1b
(polar ps1a (+ (angle ps3 ps1) (DTR 90)) ts1)
ps1c (polar ps1 ang ts2)
)
(command "_line"
ps1b ps1c ""
"_pline" qs1 qs2 qs3 ps1c
""
)
;;-----------Upper Flight----------------
(setq ps qs1
;ps (polar ps (dtr 90) (* his nums))
ps1 ps ;(polar ps ang4 (/ ws 2.0))
ps2 (polar ps1 (dtr 90) his)
ps3 (polar ps2 ang4a ri)
ps1a ps1
)
(setq ang5 (angle
ps1 ps3)
ts (/(* ri nums) 20)
ts1 (/ ts (cos ang5))
ts2 (* ts1
(tan (dtr(- 180 (+ 90 (rtd ang5))))))
)
(repeat nums ;(1+ nums)
(command
"_pline" ps1 ps2 ps3 "")
(setq ps1
ps3
ps2 (polar ps1 (dtr 90) his)
ps3 (polar ps2 ang4a ri)
)
);;repeat
(setq qs1
ps1
qs2 (polar qs1 ang4a ws)
qs3 (polar qs2 (dtr 270) his)
)
(setq ps1 (polar
ps1 (angle ps3 ps1)(sqrt
(+(expt ri 2)(expt his 2)))))
(setq ps1b
(polar ps1a (+ (angle ps3 ps1) (DTR 90)) ts1)
ps1c (polar ps1 ang4a ts2)
)
(command "_line"
ps1b ps1c ""
"_pline" qs1 qs2 qs3 ps1c
""
)
)
)
);progn
);if Half-Turn
(setvar
"cmdecho" old_cmdecho)
(setvar "osmode"
old_osnap)
(setvar
"snapmode" old_snap)
(setvar
"orthomode" old_ortho)
(setvar "clayer"
old_layer)
(setvar
"textstyle" old_tstyle)
(setvar
"textsize" txts)
(setq *error* old_error)
(princ)
)
(defun c:ST ()
(stair)
)
(prompt "\nCreate and
Design by Songkhran Jongkul October 2016")
(prompt "\nEnter ST
to Start")
