วันจันทร์ที่ 22 พฤศจิกายน พ.ศ. 2564
วันจันทร์ที่ 1 พฤศจิกายน พ.ศ. 2564
Closed Boundary Selection
;|
closed boundary in the selection
|;
(defun
my_error (msg)
(setvar
"cmdecho" old_cmdecho)
(if
(or
(= msg "Function cancelled")
(= msg "quit / exit abort")
)
(princ)
(princ (strcat "\nError: " msg))
)
(if
msg (Alert (strcat "\nApplication error: " msg)))
(setvar "cmdecho" old_cmdecho)
(setvar "osmode" old_osnap)
(setvar "snapmode" old_snap)
(setvar "orthomode" old_ortho)
(setvar "dimdec" old_dimdec)
(setq *error* old_error)
(princ)
);;end
my_error
(defun
c:cbs (/ clayer pa pb dis ay by th th0 lp rp inter1 inter1mid inter2 inter2mid
i len plboundary)
(setq
old_cmdecho(getvar "cmdecho"))
(setq
old_osnap (getvar "osmode"))
(setq
old_layer (getvar "clayer")) ;
layer
(setq
old_error *error*)
(setq
*error* my_error )
(setvar
"cmdecho" 0)
(setvar
"osmode" 0)
(command "_undo"
"_be")
(setq old_layer (getvar
"clayer"))
(if
(not (tblsearch "LAYER" "mybound"))
(command "._layer"
"_M" "mybound" "_Color" "3"
"" "LType" "Continuous" ""
"")
)
(setq pa (getpoint "\n Pick the left
up point"))
(setq pb (getcorner pa "\n Pick the
bottom right point"))
(setq dis (getdist "\n Enter minimum
distance"))
(setq ay (nth 1 pa)
by (nth 1 pb)
)
(setq th by)
(setq th0 dis)
(while
(< th ay)
(setq lp (list (nth 0 pa) th 0))
(setq rp (list (nth 0 pb) th 0))
(grdraw lp rp 249)
(setq inter1 (vl-Get-Int-Pt lp rp
"mybound" 0))
(setq inter1mid (midlist inter1))
(setq inter2 (vl-Get-Int-Pt lp rp
"mybound" 1)
inter2mid (midlista inter2)
)
(setvar "clayer"
"mybound")
(setq i 0
len (length inter1)
)
(repeat (1- len)
(setq midpoint (nth i inter1mid))
(if (not (member1 midpoint
inter2mid))
(progn
(setq plboundary
(STD-BPOLY midpoint nil))
(if plboundary
(setq inter2
(vl-Get-Int-Pt lp rp "bound" 1)
inter2mid (midlista inter2)
)
)
)
)
(setq i (1+ i))
)
(setvar "clayer" old_layer)
(setq th (+ th th0))
)
(command "_undo" "_e"
"_redraw"
)
(setvar
"cmdecho" old_cmdecho)
(setvar
"osmode" old_osnap)
(setvar
"clayer" old_layer)
(setq
*error* old_error)
(princ)
)
;;------------------------------------
(prompt
"\n Enter CBS to Start closed boundary in the selection.")
;;------------------------------------
(defun
member1 (a b / res)
(if b
(foreach x b
(if (< (distance x a) 0.01)
(progn
(setq res T)
) ; (setq res nil)
)
) ; (setq res nil)
)
res
)
;;------------------------------------
(defun
midlist (lst / len lst1 midpoint i)
(setq i 0
len (length lst)
)
(repeat (1- len)
(setq midpoint (midp (nth i lst) (nth (1+
i) lst)))
(setq lst1 (append
lst1
(list midpoint)
)
)
(setq i (1+ i))
)
lst1
)
;;------------------------------------
(defun
midlista (lst / len lst1 midpoint i)
(setq i 0
len (length lst)
)
(repeat (/ len 2)
(setq midpoint (midp (nth i lst) (nth (1+
i) lst)))
(setq lst1 (append
lst1
(list midpoint)
)
)
(setq i (+ i 2))
)
lst1
)
;;------------------------------------
(defun
STD-BPOLY (pt ss / ele)
(cond
((member (type C:BPOLY) '(SUBR EXRXSUBR
EXSUBR))
(if ss
(C:BPOLY pt ss) ; old arx or ads
function
(C:BPOLY pt)
)
)
(pt ; >=r14: native command
(setvar "CMDDIA" 0)
(setq ele (entlast))
; (std-break-command)
(command "_BPOLY"
"_A" "_I" "_N" "") ; advanced options
; without island detection
(if ss
(command "_B"
"_N" ss "")
) ; define boundary set if ss
(command "" pt "")
(setvar "CMDDIA" 1)
(if (/= (entlast) ele)
(entlast)
)
) ; return created BPOLY
(T
(alert "command _BPOLY not
available")
)
)
)
;;------------------------------------
(defun
vl-Get-Int-Pt (FirstPoint SecondPoint lay layindex / acadDocument
mSpace
SSetName SSets SSet reapp ex obj
Baseline
)
(vl-load-com)
(setq acadDocument (vla-get-ActiveDocument
(vlax-get-acad-object)))
(setq mSpace (vla-get-ModelSpace
acadDocument))
(setq SSetName "MySSet")
(setq SSets (vla-get-SelectionSets
acadDocument))
(if (vl-catch-all-error-p (vl-catch-all-apply
'vla-add (list SSets
SSetName
)
)
)
(vla-clear (vla-Item SSets SSetName))
)
(setq SSet (vla-Item SSets SSetName))
(setq Baseline (vla-Addline mspace
(vlax-3d-point FirstPoint)
(vlax-3d-point
SecondPoint)
)
)
(vla-SelectByPolygon SSet acSelectionSetFence
(kht:list->safearray
(append
FirstPoint
SecondPoint
)
'vlax-vbdouble
)
)
(vlax-for obj sset (if (setq ex
(kht-intersect
(vlax-vla-object->ename BaseLine)
(vlax-vla-object->ename obj)
lay layindex
)
)
(setq reapp (append
reapp
ex
)
)
)
)
(vla-delete BaseLine)
(setq reapp (vl-sort reapp '(lambda (e1 e2)
(< (car e1)
(car e2))
)
)
)
reapp
)
;;------------------------------------
(defun
kht-intersect (en1 en2 lay layindex / a b x ex ex-app c d e la2)
(vl-load-com)
(setq c (cdr (assoc 0 (entget en1)))
d (cdr (assoc 0 (entget en2)))
la2 (cdr (assoc 8 (entget en2)))
)
(if (or
(= c "TEXT")
(= d "TEXT")
(= c "SPLINE")
(= d "SPLINE")
)
(setq e -1)
)
(if (= layindex 0)
(if (= la2 lay)
(setq e -1)
)
)
(if (= layindex 1)
(if (/= la2 lay)
(setq e -1)
)
)
(setq En1 (vlax-ename->vla-object En1))
(setq En2 (vlax-ename->vla-object En2))
(setq a (vla-intersectwith en1 en2
acExtendNone))
(setq a (vlax-variant-value a))
(setq b (vlax-safearray-get-u-bound a 1))
(if (= e -1)
(setq b e)
)
(if (/= b -1)
(progn
(exapp a)
)
nil
)
)
(defun
exapp (a)
(setq a (vlax-safearray->list a))
(repeat (/ (length a) 3)
(setq ex-app (append
ex-app
(list (list (car a) (cadr a)
(caddr a)))
)
)
(setq a (cdr (cdr (cdr a))))
)
ex-app
)
(defun
kht:list->safearray (lst datatype)
(vlax-safearray-fill (vlax-make-safearray
(eval datatype) (cons 0
(1-
(length lst)
)
)
) lst
)
)
;;;
----------------------------------------------------------
;;;
| midpoint function |
;;;
----------------------------------------------------------
(defun
midp (p1 p2)
(mapcar
'(lambda (x)
(/ x 2.)
)
(mapcar
'+
p1
p2
)
)
)
วันอังคารที่ 12 ตุลาคม พ.ศ. 2564
Hatch Polyline Closed by Layer
(defun
c:hplc (/ color en ha hp hs lname ltable sset)
(setq
old_cmdecho (getvar
"cmdecho"))
(setvar "cmdecho" 0)
(initget
"ANSI37 AR-CONC AR-SAND EARTH")
(setq
ptname (getkword "\nSelect Pattern Name [ANSI37/AR-CONC/AR-SAND/EARTH]
:<ANSI37>"))
(if (= ptname "")(setq ptname "ANSI37"))
(setq
hp (getvar "hpname"))
(setvar
"hpname" ptname) ;<-- hatch pattern name
(setq
ha (getvar "hpassoc"))
(setvar
"hpassoc" 1) ;<-- set hatch associative
(setq
hs (getvar "hpscale"))
(setvar "hpscale" 2.0) ;<-- set hatch pattern scale
(if
(and
(setq e (car (entsel "\nSelect
entity for layer name: ")))
(setq e (tblsearch "layer"
(cdr (assoc 8 (entget e)))))
(setq lyn (cdr (assoc 2 e)))
(setq
sset
(ssget "_X"
(list
(cons 0 "LWPOLYLINE") ;<--
lightweight polylines only
(cons 70 1) ;<--
closed polylines
(cons 410 (getvar
"CTAB")) ;<-- current space
(cons 8 lyn) ;<-- layer
name;"Layer1,Layer2,Layer3"<--desired layer names, separated by
comma
)
)
)
)
(while
(setq en (ssname sset 0))
(setq lname (cdr (assoc 8 (entget en))))
(setq ltable (tblsearch "layer"
lname))
(setq color (cdr (assoc 62 ltable)))
(command "._-hatch"
"_S" en "" "")
(command "._change"
(entlast)
""
"_PR"
"_Layer"
lname
"_Color"
"BYLAYER"
""
)
(ssdel en sset)
)
(alert
" Polyline Object is Don't Closed ")
)
(setvar
"hpname" hp) ;<-- restore hatch patter name
(setvar
"hpassoc" ha) ;<-- restore hatch asociativity
(setvar
"hpscale" hs) ;<-- restore hatch patter scale
(setvar
"cmdecho" old_cmdecho)
(princ)
)
(prompt
"\nEnter HPLC to start Hatch Polyline Closed by Layer")
(princ)
วันศุกร์ที่ 8 ตุลาคม พ.ศ. 2564
Stair
;|
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")
สมัครสมาชิก:
บทความ (Atom)