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

(defun c:dct(/ eao)
(setvar "blipmode" 0)
(if (not cwidth)
(setq cwidth 0.0)
)
(MENUCMD "S=DUCT1")
(prompt (strcat "\n Enter duct width : "))
(setq tcwidth (getreal))
(if tcwidth
(setq cwidth tcwidth)
)
(MENUCMD "S=S")
(setq pt1 (getpoint "\nStart point... "))
(if pt1
(setq pt2 (getpoint pt1 "\nTo point... "))
)
(setq threshold 1
segment 0
oang nil
ofrad (getvar "filletrad")
)
(if (>= cwidth threshold)
(setq inrad (* 1.0 cwidth) outrad (* 2.0 cwidth))
)
(while pt2
(setq a (angle pt1 pt2)
1o1 (polar pt1 (+ a (/ pi 2.0)) (/ cwidth 2.0))
1o2 (polar pt2 (+ a (/ pi 2.0)) (/ cwidth 2.0))
ro1 (polar pt1 (- a (/ pi 2.0)) (/ cwidth 2.0))
ro2 (polar pt2 (- a (/ pi 2.0)) (/ cwidth 2.0))
)
(if (> segment 0)
(setq eao ea ebo eb)
(setq dimpt (polar pt1 (+ a (/ pi 2.0))(+ (/ cwidth 2.0) 1.0)))
)
(command "line" 1o1 1o2 "")
(setq ea (entlast))
(command "line" ro1 ro2 "")
(setq eb (entlast))
(if (and (> segment 0)(/= a oang)(/= pi (abs (- a oang))))
(progn
(setq xa (- oang a))
(if (or ( xa 0)( segment 0)
(setq po1 (cdr (assoc 11 (entget eao))))
)
(setq ss (ssadd eb))
(setq ss (ssadd ebo ss))
(setvar "filletrad" rb)
(command "fillet" (ssname ss 0)(ssname ss 1))
)
)
(setq pp2 (cdr (assoc 10 (entget eb))))
(if (> segment 0)
(setq po2 (cdr (assoc 11 (entget ebo))))
)
(if (and (> segment 0)(/= a oang))
(command "line" pp1 pp2 "")
(command "line" 1o1 ro1 "")
)
(if (and (> segment 0)(/= a oang))
(command "line" po1 po2 "")
)
(setq res "C")
(menucmd "S=duct2")
(setq res (getstring "Continue, Split, Double-Split, Transition : "))
(menucmd "S=S")
(cond
((or (= res "t")(= res "T")) (transition))
((or (= res "s")(= res "S")) (splitter))
((or (= res "d")(= res "D")) (splitter2))
(t (carryon))
)
) ;; END WHILE

(setq op1 (cdr (assoc 11 (entget ea))))
(setq op2 (cdr (assoc 11 (entget eb))))
(if (/= a oang)
(command "line" op1 op2 "")
(command "line" 1o2 ro2 "")
)
(setvar "filletrad" ofrad)
(setvar "cmdecho" 1)
(setvar "blipmode" 0)
(prin1)
)

(defun transition ()
(menucmd "S=DUCT1")
(setq newsize (getreal "\nEnter new size: "))
(menucmd "S=S")
(setq tlen (abs (* 3.732 (- cwidth newsize))))
(setq apt (getpoint pt2 "\nSide to remain straight"))
(setq rt-a (angle pt2 apt))
(setq s-rt (rtd (- a (/ pi 2.0))))
(if (< s-rt 0.0)
(setq s-rt (+ 360.0 s-rt))
)
; make sure all angles are positive ie -90 deg = 270 deg
(if (= (rtd rt-a) s-rt)
(setq dir "R")
(if (= rt-a a)
(setq dir "S")
(setq dir "L")
)
)
(if (= dir "L")
(setq newang (- a (/ pi 2.0)) spt 1o2)
(if (= dir "R")
(setq newang (+ a (/ pi 2.0)) spt ro2)
(setq newang a spt 1o2)
)
)
(if (or (= dir "R")(= dir "L"))
(progn
(setq l1p (polar spt a tlen))
(setq pt1 (polar l1p newang (/ newsize 2.0)))
(setq r1p (polar l1p newang newsize ))
(if (= dir "L")
(command "line" 1o2 ro2 r1p l1p "c")
(command "line" 1o2 ro2 l1p r1p "c")
)
) ; end progn
(progn
(setq tlen (/ tlen 2.0))
(setq p1 (polar pt2 a tlen))
(setq p2 (polar p1 (+ a (/ pi 2.0)) (/ newsize 2.0)))
(setq p3 (polar p2 (- a (/ pi 2.0)) newsize))
(command "line" p2 p3 ro2 1o2 p2 "")
(setq pt1 p1)
)
)
(setq pt2 (getpoint pt1 "\nTo point..."))
(if pt2
(progn
(while (< (+ (distance pt1 pt2) (/ cwidth 2.0)) outrad)
(setq pt2 (getpoint pt1 "\nTo point..."))
)
(setq segment (1+ segment))
(setq tcwidth newsize cwidth newsize oang a)
(setq inrad (* 1.0 cwidth) outrad (* 2.0 cwidth))
) ;; END PROGN
) ;; END IF
)

(defun carryon ()
;; BEGINNING FOR NORMAL CONTINUE OF DUCTING
(progn
(setq oang a
pt1 pt2
pt2 (getpoint pt1 "\nTo point..."))
(if pt2
(progn
(while (< (+ (distance pt1 pt2) (/ cwidth 2.0)) outrad)
(setq pt2 (getpoint pt1 "\nTo point..."))
)
(setq segment (1+ segment))
) ;; END PROGN
) ;; END IF
) ;; END OF PROGN FOR CONTINUE OPTION
)

;; branching ductwork
(defun splitter ()
(setq orth (getvar "ORTHOMODE"))
(setvar "ORTHOMODE" 1)
(setq apt (getpoint pt2 "\nDirection of Branch"))
(setq rt-a (angle pt2 apt))
(setq s-rt (rtd (- a (/ pi 2.0))))
(if (< s-rt 0.0)
(setq s-rt (+ 360.0 s-rt))
)
; make sure all angles are positive ie -90 deg = 270 deg
(if (= (rtd rt-a) s-rt)
(setq s-dir "R")
(setq s-dir "L")
)
(setvar "ORTHOMODE" orth)
(menucmd "S=duct1")

(setq s-dw1 (getreal "\nWidth of Branch Duct: "))
(setq s-dw2 (1+ cwidth))
; the main duct cannot increase here
(while (< cwidth s-dw2)
(setq s-dw2 (getreal "\nWidth of Continuing Main Duct: "))
)
(menucmd "S=S")
(setq c-side (* 2.0 s-dw1))
(if (= s-dir "R")
(setq s-1o2 1o2 s-ro2 ro2 arc-ang -90.0)
(setq s-1o2 ro2 s-ro2 1o2 arc-ang 90.0)
)
(setq s-p1 (polar s-1o2 a c-side))
(setq s-p2 (polar s-1o2 rt-a s-dw2))
(setq s-p3 (polar s-p2 a c-side))
(setq s-p4 (polar s-ro2 rt-a s-dw1))
(setq s-p5 (polar s-p4 a s-dw1))
(setq s-p6 (polar s-p5 a s-dw1))
(command "arc" s-ro2 "c" s-p4 "a" arc-ang)
(command "line" s-p5 s-p6 "")
(setq b-side (+ s-dw1 (- cwidth s-dw2)))
(setq a-side (sqrt (- (* c-side c-side)(* b-side b-side))))
(setq intpt (polar s-p2 a a-side))
(if (= s-dir "R")
(command "arc" s-p6 "c" s-p4 intpt)
(command "arc" intpt "c" s-p4 s-p6)
)
(command "line" intpt s-p3 s-p1 s-1o2 s-Ro2 "")
(setq 1o2 s-p1
ro2 s-p3
1o1 s-1o2
ro1 s-p2
pt1 (polar s-p1 rt-a (/ s-dw2 2.0))
cwidth s-dw2)
(setq pt2 (getpoint pt1 "\nTo point..."))
(setq tcwidth s-dw2 cwidth s-dw2 oang a)
(setq inrad (* 1.0 cwidth) outrad (* 2.0 cwidth))
)

(defun splitter2 ()
(setq s-rt (- a (/ pi 2.0)))
(setq s-rt2 (+ a (/ pi 2.0)))
(menucmd "S=duct1")
(setq s-dw1 (getreal "\nWidth of Left Branch Duct: "))
(setq s-dw2 (getreal "\nWidth of Right Branch Duct: "))
(setq rad1 (* 2.0 s-dw1))
(setq rad2 (* 2.0 s-dw2))
(setq c (+ s-dw1 s-dw2 cwidth))
(setq cosA (/ (- (+ (* RAD1 RAD1) (* c c))(* RAD2 RAD2)) (* 2.0 RAD1 c)))
(setq xlen (* cosA rad1))
(setq p1 (polar 1o2 s-rt2 s-dw1))
(setq p2 (polar p1 a s-dw1))
(setq p3 (polar p2 a s-dw1))
(setq xpt (polar p1 s-rt xlen))
(setq ylen (sqrt (- (* rad1 rad1)(* xlen xlen))))
(setq intpt (polar xpt a ylen))
(command "arc" intpt "c" p1 p3)
(command "arc" 1o2 "c" p1 p2)
(command "line" p2 p3 "")
(setq p1 (polar ro2 s-rt s-dw2))
(setq p2 (polar p1 a s-dw2))
(setq p3 (polar p2 a s-dw2))
(command "arc" p3 "c" p1 intpt)
(command "arc" p2 "c" p1 ro2)
(command "line" p2 p3 "")
(command "line" 1o2 ro2 "")
(setq 1o2 p2
ro2 p3
1o1 p2
ro1 p3
pt1 (polar p2 a (/ s-dw2 2.0))
cwidth s-dw2)
(setq pt2 (getpoint pt1 "\nTo point..."))
(setq tcwidth s-dw2 cwidth s-dw2 oang (- a (/ pi 2.0)))
(setq inrad (* 1.0 cwidth) outrad (* 2.0 cwidth))
)
(c:dct)

Advertisements