;;;; Duct Draw Program from Turkish developers
;;;; Translated to English by Igal Averbuh 2016
;** MAIN **
(defun c:kk (/ sys layer rad gen yuk p1 nesne)
(if (= sys nil)
(progn
(setq sys "SA")
)
)
(if (= layer nil)
(progn
(setq layer "MEC-DUCT-SA")
)
)
(setq e_ang nil)
(if (= ins nil)
(progn
(setq ins 25)
)
)
(if (= rad nil)
(progn
(setq rad 150)
)
)
(if (= gen nil)
(progn
(setq gen 200)
)
)
(if (= yuk nil)
(progn
(setq yuk 200)
)
)
(princ (strcat "\nCurent Settings: Width="
(rtos gen 2 0)
", Width="
(rtos yuk 2 0)
", Radius="
(rtos rad 2 0)
", System="
sys
)
)
(setq p1 (getpoint "\nStarting point of duct:"))
(setq nesne (ssget p1))
(if (/= nesne nil)
(progn
(if (/= nil
(setq xdata_list
(cdr
(assoc -3
(entget (ssname nesne 0) '("DuctData"))
)
)
)
)
(progn
(setq sys (cdr (nth 3 (car xdata_list))))
(setq gen (cdr (nth 4 (car xdata_list))))
(setq yuk (cdr (nth 5 (car xdata_list))))
(setq ins (cdr (nth 6 (car xdata_list))))
(setq layer (strcat "MEC-DUCT-" sys))
)
(progn
(setq layer (cdr (assoc 8 (entget (ssname nesne 0)))))
)
)
(setq ps (cdr (assoc 10 (entget (ssname nesne 0))))
pf (cdr (assoc 11 (entget (ssname nesne 0))))
)
(setq gen (distance ps pf)
ang (angle ps pf)
)
(setq p1 (polar ps ang (/ gen 2)))
)
)
(initget 1024 "Section / Insulation / Radius / System")
(while (/= nil
(setq p2
(getpoint
p1
(strcat
"\nNext point or [Section / Insulation / Radius / System] in mm:"
)
)
)
)
(if (= p2 "Undo")
(progn
(command "_.undo" "")
)
(progn
(command "undo" "group")
(cond
((= p2 "System")
(system_gir)
)
((= p2 "Radius")
(radius_gir)
)
((= p2 "Section")
(kesit_gir)
)
((= p2 "Insulation")
(ins_gir)
)
((/= nil e_ang)
(dirsek_ciz)
(setq p1 p2)
(setq e_l1 l1
e_l2 l2
)
(if (/= ins 0)
(progn
(setq e_li1 li1
e_li2 li2
)
)
)
)
((and (/= p2 "Section")
(/= p2 "Insulation")
(/= p2 "System")
)
(kanal_ciz)
(setq p1 p2)
(setq e_l1 l1
e_l2 l2
)
(if (/= ins 0)
(progn
(setq e_li1 li1
e_li2 li2
)
)
)
)
)
)
)
(initget 1024 "Section / Insulation / Radius / System")
(command "_.undo" "end")
)
)
;** **
;**************************************************************************************************

;**************************************************************************************************
;** INSULATION GIRISI **
(defun ins_gir ()
(setq e_ins ins)
(setq ins (getreal (strcat "\nEnter the new insulation thickness:"
)
)
)
(if (= nil ins)
(progn
(setq ins e_ins)
)
)
)
;** **
;**************************************************************************************************

;**************************************************************************************************
;** KESIT GIRISI **
(defun kesit_gir ()
(setq e_gen gen
e_yuk yuk
)
(setq
gen (getreal
(strcat "\nEnter duct width :")
)
)
(if (= gen nil)
(progn
(setq gen e_gen)
)
)
(setq
yuk (getreal
(strcat "\nEnter duct height :")
)
)
(if (= yuk nil)
(progn
(setq yuk e_yuk)
)
)
(if (and (/= e_ang nil)(or (/= yuk e_yuk) (/= gen e_gen)))
(progn
(red_ciz)
)
)
)
;** **
;**************************************************************************************************

;**************************************************************************************************
;** KANAL PARAMETRE **
(defun kanal_ciz ()
(setq e_ang ang)
(setq ang (angle p1 p2))
(setq pl1s (polar p1 (+ ang (dtr 90)) (/ gen 2))
pl1f (polar p2 (+ ang (dtr 90)) (/ gen 2))
pl2s (polar p1 (- ang (dtr 90)) (/ gen 2))
pl2f (polar p2 (- ang (dtr 90)) (/ gen 2))
)
(if (/= ins 0)
(progn
(setq pi1s (polar p1 (+ ang (dtr 90)) (+ ins (/ gen 2)))
pi1f (polar p2 (+ ang (dtr 90)) (+ ins (/ gen 2)))
pi2s (polar p1 (- ang (dtr 90)) (+ ins (/ gen 2)))
pi2f (polar p2 (- ang (dtr 90)) (+ ins (/ gen 2)))
)
)
)
(line_ciz layer pl1s pl1f)
(setq l1 (entlast))

(line_ciz layer pl2s pl2f)
(setq l2 (entlast))

(if (/= ins 0)
(progn
(if (< ins 0)
(progn
(setq lay (strcat layer "_AKUSTIK_INSULATION"))
)
(progn
(setq lay (strcat layer "-INSULATION"))
)
)
(line_ciz lay pi1s pi1f)
(setq li1 (entlast))

(line_ciz lay pi2s pi2f)
(setq li2 (entlast))

)
)
)
;** **
;**************************************************************************************************

;**************************************************************************************************
;** KANAL CIZDIRME **
(defun line_ciz (#l8 #l10 #l11)
(entmake (list
(cons 0 "LINE")
(cons 8 #l8)
(cons 10 #l10)
(cons 11 #l11)
)
)
)
;** **
;**************************************************************************************************

;**************************************************************************************************
;** DERECEDEN RADYANA GECIS **
(defun dtr (#aci)
(* pi (/ #aci 180.0))
)
;** **
;**************************************************************************************************

;**************************************************************************************************
;** DIRSEK CIZ **
(defun dirsek_ciz ()
(setq e_pl1s pl1s
e_pl2s pl2s
e_pl1f pl1f
e_pl2f pl2f
)
(kanal_ciz)
(setq n1 (list (nth 0 pl1s) (nth 1 pl1s)))
(setq n2 (list (nth 0 pl1f) (nth 1 pl1f)))
(setq n3 (list (nth 0 e_pl1s) (nth 1 e_pl1s)))
(setq n4 (list (nth 0 e_pl1f) (nth 1 e_pl1f)))
(setq p1x (inters n1 n2 n3 n4 t))
(setq n1 (list (nth 0 e_pl2s) (nth 1 e_pl2s)))
(setq n2 (list (nth 0 e_pl2f) (nth 1 e_pl2f)))
(setq n3 (list (nth 0 pl2s) (nth 1 pl2s)))
(setq n4 (list (nth 0 pl2f) (nth 1 pl2f)))
(setq p2x (inters n1 n2 n3 n4 t))
(setq e_rad (getvar "filletrad"))
(if (< p2x p1x)
(progn
(setvar "filletrad" rad)
(command "FILLET" l1 e_l1)
(x_arc (setq arc (entlast)))
(setq pa1s pas
pa1f paf
)
(setvar "filletrad" (+ gen rad))
(command "FILLET" l2 e_l2)
(x_arc (entlast))
(setq pa2s pas
pa2f paf
)
(if (/= ins 0)
(progn
(setvar "filletrad" (- rad ins))
(command "FILLET" li1 e_li1)
(setvar "filletrad" (+ ins gen rad))
(command "FILLET" li2 e_li2)
)
)
)
)
(if (< p1x p2x)
(progn
(setvar "filletrad" rad)
(command "FILLET" l2 e_l2)
(x_arc (setq arc (entlast)))
(setq pa2s pas
pa2f paf
)
(setvar "filletrad" (+ gen rad))
(command "FILLET" l1 e_l1)
(x_arc (entlast))
(setq pa1s pas
pa1f paf
)
(if (/= ins 0)
(progn
(setvar "filletrad" (- rad ins))
(command "FILLET" li2 e_li2)
(setvar "filletrad" (+ ins gen rad))
(command "FILLET" li1 e_li1)
)
)
)
)
(line_ciz layer pa1s pa2s)
(setq l- (entlast))
(if (< e_ang ang)
(progn
(setq ang_fark (- ang e_ang)))
(progn
(setq ang_fark (- e_ang ang))))
(setq d_ang (rtd ang_fark))
(cond
((< d_ang 90)
(setq d_ang d_ang))
((< d_ang 180)
(setq d_ang (- 180 d_ang)))
((< d_ang 270)
(setq d_ang (- 270 d_ang)))
((vla-object nent))
(setq pas (vlax-curve-getEndPoint data))
(setq paf (vlax-curve-getstartPoint data))
)
;** **
;**************************************************************************************************

;**************************************************************************************************
;** RADIUS GIRISI **
(defun radius_gir ()
(setq e_rad rad)
(setq rad (getreal (strcat "\nEnter the new insulation thickness:"
)
)
)
(if (= nil rad)
(progn
(setq rad e_rad)
)
)
)
;** **
;**************************************************************************************************

;**************************************************************************************************
;** REDUKSIYON CIZ **
(defun red_ciz ()
(if (= nil red_len)
(progn
(setq red_len 300)
)
)
(setq e_red_len red_len)
(setq red_len (getreal (strcat "\nEnter reduction size :"
)
)
)
(if (= red_len nil)
(progn
(setq red_len e_red_len)
)
)
(prompt "\nChoose Your:")
(while (or (= (car (setq #grread (grread t 5 0))) 5)
(= (car (setq #grread (grread t 5 0))) 2)
)
(redraw)
(setq pin (cadr #grread))
(setq pp1 (polar pin ang 100))
(setq ppx (inters pl1f pl2f pin pp1 nil))
(setq fark (distance p1 ppx))
(if (< fark (/ e_gen 4))
(progn
(setq p2 (polar p1 ang red_len))
(setq pr1f (polar p2 (+ ang (dtr 90)) (/ gen 2)))
(setq pr2f (polar p2 (- ang (dtr 90)) (/ gen 2)))
(if (/= ins 0)
(progn
(setq pri1f (polar p2 (+ ang (dtr 90)) (+ ins (/ gen 2))))
(setq pri2f (polar p2 (- ang (dtr 90)) (+ ins (/ gen 2))))
)
)
)
(progn
(setq fark1 (distance ppx pl1f))
(setq fark2 (distance ppx pl2f))
(setq ang_1 (angle pl1f ppx))
(setq ang_2 (angle pl2f ppx))
(if (< fark1 fark2)
(progn
(setq pr1f (polar pl1f ang red_len))
(setq pr2f (polar pr1f ang_1 gen))
(setq p2 (polar pr1f ang_1 (/ gen 2)))
(if (/= ins 0)
(progn
(setq pri1f (polar pi1f ang red_len))
(setq pri2f (polar pr1f ang_1 (+ ins gen)))
)
)
)
(progn
(setq pr2f (polar pl2f ang red_len))
(setq pr1f (polar pr2f ang_2 gen))
(setq p2 (polar pr2f ang_2 (/ gen 2)))
(if (/= ins 0)
(progn
(setq pri2f (polar pi2f ang red_len))
(setq pri1f (polar pr2f ang_2 (+ ins gen)))
)
)
)
)
)
)
(grdraw pl1f pr1f 1 1)
(grdraw pl2f pr2f 1 1)
(grdraw pr1f pr2f 1 1)
(if (/= ins 0)
(progn
(grdraw pi1f pri1f 1 1)
(grdraw pi2f pri2f 1 1)
)
)
)
(line_ciz layer pl1f pr1f)
(setq l1 (entlast))

(line_ciz layer pl2f pr2f)
(setq l- (entlast))

(line_ciz layer pr1f pr2f)
(setq l- (entlast))

(line_ciz layer pl1f pl2f)
(setq l- (entlast))

(setq pl1f pr1f
pl2f pr2f
p1 p2
)
(if (/= ins 0)
(progn
(line_ciz lay pi1f pri1f)
(line_ciz lay pi2f pri2f)
(setq pi1f pri1f
pi2f pri2f
)
)
)
)
;** **
;**************************************************************************************************

;**************************************************************************************************
;** SYSTEM GIRISI **
(defun system_gir ()
(setq e_sys sys)
(setq sys (getstring (strcat "\nEnter System name:"
)
T)
)
(if (= "" sys)
(progn
(setq sys e_sys)
)
)
(setq layer (strcat "MEC-DUCT-"(strcase sys)))
)
;** **
;**************************************************************************************************
(c:kk)

Advertisements