;;; 2D Duct Drawing program. Dedicated to TOPAZ Bareket LTD. Created by Igal Averbuh 2016
;;; Based on many subroutines of other developers

(defun ducprogerr (errmes)
(if (/= errmes "Function cancelled")
(if (= errmes "quit / exit abort")
(princ)
(princ (strcat "\nError Message: " errmes))
)
)
(ducvarr-ret)
(princ)
(terpri)
)
(defun ducvarr-res()
(setq oldprerr *error* *error* ducprogerr)
(setq blmp-varr (getvar "blipmode"))
(setq osm-varr (getvar "osmode"))
(setq cmd-varr (getvar "cmdecho"))
(setq cla-varr (getvar "clayer"))
(setq pk-varr (getvar "pickbox"))
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
)

(defun ducvarr-ret()
(setvar "blipmode" blmp-varr)
(setvar "cmdecho" cmd-varr)
(setvar "osmode" osm-varr)
(setvar "clayer" cla-varr)
(setvar "pickbox" pk-varr)
(setq *error* oldprerr)
(princ)
)
(setq reducrat1 4.0)
(setq reducrat2 4.0)
(setq sductscale 1.0)
(defun stpt(l) (CDR (ASSOC 10 (ENTGET l))))
(defun enpt(l) (CDR (ASSOC 11 (ENTGET l))))
(defun angg (l) (angle (stpt l) (enpt l)))
(defun intp(l1 l2) (inters (stpt l1) (enpt l1) (stpt l2) (enpt l2) nil))
(defun len(l) (distance (stpt l) (enpt l)))
(defun vec(l / le)
(mapcar '/ (mapcar '- (enpt l) (stpt l)) (list (setq le (len l)) le le))
)
(defun reduc(pt1 pt2 fwid swid ang def / redp1 redp2 redp3 redp4 redpt remlen redlen tdpt redrat1 redrat2 ans rat loop)
(initget "Right Left Middle rAtio")
(setq dir (getkword (strcat "\nReducer: [rAtio/Middle/Left/Right]: ")))
(if (not dir) (setq dir def))
(cond
((= dir "Left")
(setq redlen (abs (* (- fwid swid) reducrat1)))
(setq redp1 (polar pt1 (+ ang (/ pi 2)) (/ fwid 2)))
(setq redp2 (polar redp1 ang redlen))
(setq redp3 (polar redp2 (- ang (/ pi 2)) swid))
(setq redp4 (polar pt1 (- ang (/ pi 2)) (/ fwid 2)))
(setq redpt (polar redp2 (- ang (/ pi 2)) (/ swid 2)))
(princ (strcat "\nreducer slope ratio is " (rtos reducrat1)))
)
((= dir "Right")
(setq redlen (abs (* (- fwid swid) reducrat1)))
(setq redp1 (polar pt1 (- ang (/ pi 2)) (/ fwid 2)))
(setq redp2 (polar redp1 ang redlen))
(setq redp3 (polar redp2 (+ ang (/ pi 2)) swid))
(setq redp4 (polar pt1 (+ ang (/ pi 2)) (/ fwid 2)))
(setq redpt (polar redp2 (+ ang (/ pi 2)) (/ swid 2)))
(princ (strcat "\nReducer slope ratio is " (rtos reducrat1)))
)
((= dir "Middle")
(setq redlen (abs (* (- fwid swid) (/ reducrat2 2))))
(setq redpt (polar pt1 ang redlen))
(setq redp1 (polar pt1 (+ ang (/ pi 2)) (/ fwid 2)))
(setq redp4 (polar pt1 (- ang (/ pi 2)) (/ fwid 2)))
(setq redp2 (polar redpt (+ ang (/ pi 2)) (/ swid 2)))
(setq redp3 (polar redpt (- ang (/ pi 2)) (/ swid 2)))
(princ (strcat "\nReducer slope ratio is " (rtos reducrat2)))
)
((= dir "rAtio")
(setq loop t)
(while loop
(setq loop nil)
(initget 128 "Globaly")
(setq rat (getreal "\n/Globaly:] "))
(cond
((= rat "Globaly")
(initget 6)
(setq ans (getreal (strcat "\None sided reducer slope ratio?: ")))
(if ans (setq reducrat1 ans))
(initget 6)
(setq ans (getreal (strcat "\nDouble sided reducer slope ratio?: ")))
(if ans (setq reducrat2 ans))
(setq tdpt (reduc pt1 pt2 fwid swid ang def))
)
((and (= (type rat) 'REAL) (< 0.0 rat))
(setq redrat1 reducrat1 redrat2 reducrat2)
(setq reducrat1 rat reducrat2 rat)
(setq tdpt (reduc pt1 pt2 fwid swid ang def))
(setq reducrat1 redrat1 reducrat2 redrat2)
)
(t
(princ "\ntry again")
(setq loop t)
)
)
)
)
)
(if tdpt
tdpt
(progn
(command "line" redp1 redp2 redp3 redp4 "")
(if (< (distance pt1 pt2) redlen)
(progn
(initget 5)
(setq remlen (getdist redpt "\nDistance of the next point"))
)
(setq remlen (- (distance pt2 pt1) redlen))
)
(list
redpt
(polar redpt ang remlen)
)
)
)
)

(defun twol(pt1 pt2 wid ang / pu1 pu2 pl1 pl2)
(setq pu1 (polar pt1 (+ ang (/ pi 2)) (/ wid 2)))
(setq pu2 (polar pt2 (+ ang (/ pi 2)) (/ wid 2)))
(setq pl1 (polar pt1 (- ang (/ pi 2)) (/ wid 2)))
(setq pl2 (polar pt2 (- ang (/ pi 2)) (/ wid 2)))
(list
(progn
(command "line" pu1 pu2 "")
(entlast)
)
(progn
(command "line" pl1 pl2 "")
(entlast)
)
wid
ang
)
)
(defun leng(l)
(distance (stpt l) (enpt l))
)
(defun endl(dl / pe1 pe11 pe2 pe22 ps2)
(setq pe1 (enpt (nth 0 dl)))
(setq pe2 (enpt (nth 1 dl)))
(setq ps2 (stpt (nth 1 dl)))
(if (inters pe1 (polar pe1 (- (nth 3 dl) (/ pi 2)) (+ (nth 2 dl) 0.1)) ps2 pe2)
(progn
(setq pe11 (polar pe1 (- (nth 3 dl) (/ pi 2)) (nth 2 dl)))
(command "line" pe1 pe11 "")
)
(progn
(setq pe22 (polar pe2 (+ (nth 3 dl) (/ pi 2)) (nth 2 dl)))
(command "line" pe2 pe22 "")
)
)
)

(defun startl(dl / ps1 ps2 ps11 ps22 pe2)
(setq ps1 (stpt (nth 0 dl)))
(setq ps2 (stpt (nth 1 dl)))
(setq pe2 (enpt (nth 1 dl)))
(if (inters ps1 (polar ps1 (- (nth 3 dl) (/ pi 2)) (+ (nth 2 dl) 0.1)) ps2 pe2)
(progn
(setq ps11 (polar ps1 (- (nth 3 dl) (/ pi 2)) (nth 2 dl)))
(command "line" ps1 ps11 "")
)
(progn
(setq ps22 (polar ps2 (+ (nth 3 dl) (/ pi 2)) (nth 2 dl)))
(command "line" ps2 ps22 "")
)
)
)
(defun fil(dl1 dl2 / r1 r2)
(if (<= (nth 2 dl1) (nth 2 dl2))
(progn
(setq r1 (/ (nth 2 dl2) 2))
(setq r2 (+ (nth 2 dl1) r1))
)
(progn
(setq r1 (/ (nth 2 dl1) 2))
(setq r2 (+ (nth 2 dl2) r1))
)
)
(IF (or (< 0 (- (nth 3 dl2) (nth 3 dl1)) pi) (/[Scale]? cm: ")))
(if (not ans)
(if (/= wid 0.0)
(progn
(princ (strcat "\nthe scale factor is " (rtos sductscale)))
wid
)
(progn
(PRINC "\ntry again")
(lo1 wid)
)
)
(progn
(cond
((listp ans)
(initget 64)
(getdist ans)
)
((= ans "Scale")
(initget 6)
(setq ans (getreal (strcat "\nnew scale factor: ")))
(if ans (setq sductscale ans))
(lo1 wid)
)
((and (setq ans (atof ans)) (> ans 0.0))
(princ (strcat "\nthe scale factor is " (rtos sductscale)))
(* 1 sductscale ans)
)
(t
(PRINC "\ntry again")
(lo1 wid)
)
)
)
)
)
(defun lo3( / ans)
(initget 128 "Undo Endline")
(setq ans (getpoint))
(cond
((not ans)
(princ "\ntry agian")
(lo3)
)
((listp ans)
(initget 64)
(getdist ans)
)
((= ans "Undo")
"Undo"
)
((= ans "Endline")
(setq endcase t)
)
((and (setq ans (atof ans)) (> ans 0.0))
(princ (strcat "\nthe scale factor is " (rtos sductscale)))
(* 1 sductscale ans)
)
(t
(PRINC "\ntry again")
(lo3)
)
)
)
(defun lo2( / ans)
(initget 128 "Undo")
(setq ans (getpoint))
(cond
((not ans)
(princ "\ntry agian")
(lo2)
)
((listp ans)
(initget 64)
(getdist ans)
)
((= ans "Undo")
"Undo"
)
((and (setq ans (atof ans)) (> ans 0.0))
(princ (strcat "\nthe scale factor is " (rtos sductscale)))
(* 1 sductscale ans)
)
(t
(PRINC "\ntry again")
(lo2)
)
)
)

(defun exl(el pend / entl)
(setq entl (entget el))
(setq entl
(subst (cons 11 pend) (assoc 11 entl) entl)
)
(entmod entl)
)

(defun nextd(dl1 pt2 pt3 wid2 dir / dl2 wid1 ang1 ang2 dpt pend1 pend2)
(setq wid1 (nth 2 dl1))
(setq ang1 (nth 3 dl1))
(setq ang2 (angle pt2 pt3))
(if (and (= wid1 wid2) (equal (sin (- ang1 ang2)) 0.0 0.01))
(progn
(setq pend1 (polar pt3 (+ ang1 (/ pi 2)) (/ wid1 2)))
(setq pend2 (polar pt3 (- ang1 (/ pi 2)) (/ wid1 2)))
(mapcar 'exl (list (car dl1) (cadr dl1)) (list pend1 pend2))
(setq dl2 dl1)
)
(if (equal ang1 ang2 0.01)
(progn
(endl dl1)
(setq dpt (reduc pt2 pt3 wid1 wid2 ang1 dir))
(setq pt2 (car dpt) pt3 (cadr dpt))
(setq dl2 (twol pt2 pt3 wid2 ang2))
)
(progn
(setq dl2 (twol pt2 pt3 wid2 ang2))
(fil dl1 dl2)
(startl dl2)
)
)
)
(list dl2 pt2 pt3)
)
(defun lp0()
(initget "Continue")
(setq pt1 (getpoint "\n[Continue]/ "))
(cond
((= pt1 "Continue") (contf))
((not pt1))
(t
(setq wid1 (lo1 wid1))
(setq pt2 (getpoint pt1 "\nNext Point? "))
(if pt2
(progn
(setq ang1 (angle pt1 pt2))
(command "undo" "g")
(setq dl1 (twol pt1 pt2 wid1 ang1))
(startl dl1)
(command "undo" "e")
(setq loop t)
(setq var (list dl1 pt1 pt2))
(setq wid2 wid1)
)
(setq loop nil)
)
)
)
)
(defun contf(/ ans spt angenl angs ang2 otyp li1 li2 enline eenline
eli1 eli2 pli1 pli2 endli1 endli2 entli1 entli2
)
(setq otyp nil li1 nil)
(command "undo" "g")
(while (/= otyp "LINE")
(setq li1 nil)
(while (not li1)
(initget "Endline")
(setq li1 (entsel "\n[Endline]/ "))
)
(if (= li1 "Endline")
(progn
(setq otyp nil)
(while (/= otyp "LINE")
(setq enline nil)
(while (not enline)
(setq enline (entsel "\nSelect the endline"))
)
(setq eenline (car enline))
(setq otyp (CDR (ASSOC 0 (ENTGET eenline))))
(if (/= otyp "LINE") (PRINC "\nthis entity is not a line"))
)
(setq pt1 (osnap (cadr enline) "mid"))
(initget 1)
(setq spt (getpoint pt1 "\nDistance of the next point"))
(setq ans (distance pt1 spt))
(setq angenl (angle (stpt eenline) (enpt eenline)))
(while (or (equal angenl (angle pt1 spt) 0.01) (equal angenl (angle spt pt1) 0.01))
(initget 1)
(setq spt (getpoint "\nwhich side to continue?(pick a point)"))
)
(setq angs (angle pt1 spt))
(setq ang1 (+ angenl (/ pi 2)))
(if (< (cos (abs (- angs ang1))) 0) (setq ang1 (- ang1 pi)))
(setq wid1 (leng eenline))
(if var (setq pvar var))
(setq var
(list
(setq dl1 (twol pt1 (setq pt2 (polar pt1 ang1 ans)) wid1 ang1))
pt1
pt2
)
)
(setq loop t)
)
(progn
(setq eli1 (car li1))
(setq otyp (CDR (ASSOC 0 (ENTGET eli1))))
(if (not (= otyp "LINE")) (PRINC "\nthis entity is not a line"))
)
)
)
(if (/= li1 "Endline")
(progn
(setq pli1 (osnap (cadr li1) "end"))
(setq endli1 (enpt eli1))
(if (not (equal pli1 endli1 0.001))
(progn
(setq entli1 (entget eli1))
(setq entli1
(subst (cons 10 endli1) (assoc 10 entli1) entli1)
)
(setq entli1
(subst (cons 11 pli1) (assoc 11 entli1) entli1)
)
(entmod entli1)
)
)
(setq ang1 (angle (stpt eli1) (enpt eli1)))
(setq otyp nil)
(while (/= otyp "LINE")
(setq li2 nil)
(while (not li2)
(setq li2 (entsel "\nSelect the endpoint of the second line"))
)
(setq eli2 (car li2))
(setq otyp (CDR (ASSOC 0 (ENTGET eli2))))
(if (not (= otyp "LINE")) (PRINC "\nthis entity is not a line"))
)
(setq ang2 (angle (stpt eli2) (enpt eli2)))
(if (equal (sin (- ang1 ang2)) 0 0.01)
(progn
(setq pli2 (inters pli1 (polar pli1 (+ (/ pi 2) ang1) 1) (enpt eli2) (stpt eli2) nil))
(if (not (equal pli2 (enpt eli2) 0.001))
(progn
(setq entli2 (entget eli2))
(setq entli2
(subst (cons 11 pli2) (assoc 11 entli2) entli2)
)
(if (equal (osnap (cadr li2) "end") (stpt eli2) 0.001)
(progn
(setq endli2 (enpt eli2))
(setq entli2
(subst (cons 10 endli2) (assoc 10 entli2) entli2)
)
)
)
(entmod entli2)
)
)
(if var (setq pvar var))
(setq var
(list
(setq dl1
(append
(if (or (equal (- (angle pli2 pli1) ang1) (/ pi 2) 0.001) (equal (- (angle pli2 pli1) ang1) (- (* 3 (/ pi 2))) 0.001)) (list eli1 eli2) (list eli2 eli1))
(list
(setq wid1 (distance pli1 pli2))
ang1
)
)
)
nil
(setq pt2 (mapcar '(lambda (x y) (/ (+ x y) 2)) pli1 pli2))
)
)
(setq loop t)
)
(progn
(princ "\nthe lines are not paralell")
(if var
(setq loop t)
(lp0)
)
)
)
)
)
(command "undo" "e")
(setq wid2 wid1)
)
(defun lp1()
(initget "2 3 Undo")
(setq nubs (getkword "\n[Undo]/<Number of branchs:[ or ]>: "))
(if (/= nubs "Undo")
(progn
(if (not nubs) (setq nub 2)
(setq nub (atoi nubs))
)
(ifun1)
)
)
)
(defun ifun1()
(princ "\n[Undo]/")
(setq toff1 (lo2))
(if (= toff1 "Undo") (lp1)
(progn
(setq pbran bran)
(setq bran t)
(setq rt1 (- wid1 toff1))
(setq dl1p4 (enpt (nth 1 dl1)))
(setq bpta1 (polar dl1p4 (+ ang1 (/ pi 2)) (/ toff1 2 )))
(setq pen (polar dl1p4 (+ ang1 (/ pi 2)) toff1))
(setq pst (polar pen ang1 (- wid1)))
(command "undo" "g")
(setq bdl1
(list
(progn
(command "line" pst pen "")
(entlast)
)
(nth 1 dl1)
toff1
ang1
)
)
(command "undo" "e")
(ifun2)
)
)
)
(defun ifun2()
(setq endcase nil)
(princ "\n[Endline/Undo]/")
(setq bwid (lo3))
(if endcase
(progn
(princ "\n[Undo]/")
(setq bwid (lo2))
)
)
(cond
((= bwid "Undo")
(command "undo" "1")
(setq bran pbran)
(ifun1)
)
(t
(initget 1)
(setq bptb (getpoint bpta1 "\nNext Point? "))
(command "undo" "g")
(setq nbrdl (car (nextd bdl1 bpta1 bptb bwid "Right")))
(if endcase (endl nbrdl))
(command "undo" "e")
(setq pbdl bdl1)
(if (= nub 3)
(ifun3)
(lp6)
)
)
)
)
(defun ifun3()
(princ "\n[Undo]/")
(setq toff2 (lo2))
(cond
((= toff2 "Undo")
(command "undo" "1")
(ifun2)
)
(t
(setq rt2 (- rt1 toff2))
(setq bpta2 (polar dl1p4 (+ ang1 (/ pi 2)) (+ toff1 (/ toff2 2 ))))
(setq bpt0 (polar bpta2 ang1 (- wid1)))
(command "undo" "g")
(setq pbdl (twol bpt0 bpta2 toff2 ang1))
(command "undo" "e")
(ifun4)
)
)
)
(defun ifun4()
(setq endcase nil)
(princ "\n[Endline/Undo]/")
(setq bwid (lo3))
(if endcase
(progn
(princ "\n[Undo]/")
(setq bwid (lo2))
)
)
(if (= bwid "Undo")
(progn
(command "undo" "1")
(ifun3)
)
(progn
(initget 1)
(setq bptb (getpoint bpta2 "\nNext Point? "))
(command "undo" "g")
(setq nbrdl (car (nextd pbdl bpta2 bptb bwid "Middle")))
(if endcase (endl nbrdl))
(command "undo" "e")
(if (< (leng (nth 0 bdl1)) (leng (nth 1 pbdl)))
(setq pst1 (enpt (nth 1 pbdl)))
(setq pst1 (enpt (nth 0 bdl1)))
)
(lp6)
)
)
)
(defun lp6()
(if (= nub 3) (setq rtoff rt2) (setq rtoff rt1))
(setq bpta (polar dl1p4 (+ ang1 (/ pi 2)) (- wid1 (/ rtoff 2))))
(command "undo" "g")
(setq lbdl
(list
(nth 0 dl1)
(progn
(command "line" (stpt (nth 0 pbdl)) (polar dl1p4 (+ ang1 (/ pi 2)) (- wid1 rtoff)) "")
(entlast)
)
rtoff
ang1
)
)
(command "undo" "e")
(ifun5)
)
(defun ifun5()
(princ "\n[Undo]/")
(setq bwid (lo2))
(cond
((= bwid "Undo")
(command "undo" "2")
(if (= nub 3) (ifun4) (ifun2))
)
(t
(initget 1)
(setq bptb (getpoint bpta "\nNext Point? "))
(setq pvar var)
(command "undo" "g")
(setq var (nextd lbdl bpta bptb bwid "Left"))
(if (< (leng (nth 0 pbdl)) (leng (nth 1 lbdl)))
(setq pst2 (enpt (nth 1 lbdl)))
(setq pst2 (enpt (nth 0 pbdl)))
)
(endl dl1)
(setq pm1 (stpt (entlast)))
(setq pm2 (enpt (entlast)))
(command "erase" (nth 1 lbdl) "")
(command "erase" (nth 0 pbdl) "")
(command "line" pst2 (polar (inters pst2 (polar pst2 ang1 1) pm1 pm2 nil) ang1 (- (/ wid1 8))) "")
(if (= nub 3)
(progn
(command "erase" (nth 1 pbdl) "")
(command "erase" (nth 0 bdl1) "")
(command "line" pst1 (polar (inters pst1 (polar pst1 ang1 1) pm1 pm2 nil) ang1 (- (/ wid1 8))) "")
)
)
(command "undo" "e")
(mapcar 'set (list 'dl1 'pt1 'pt2) var)
(mapcar 'set (list 'wid1 'ang1) (cddr dl1))
(setq wid2 wid1)
(setq pbran nil)
)
)
)

(defun c:sd( / loop blpm osm wid1 wid2 ang1 ang2 pt1 pt2 pt3
dl1 dl2 toff1 toff2 rtoff bwid pen pst bpta
bptb bdl1 bdl2 pbdl bdl bang bpt0 dir nub nubs pst1 ps2
lbdl pm1 pm2 def dpt dl1p4 rt1 rt2 bpta1 bpta2
var pvar bran pbran nbrdl
)
(ducvarr-res)
(if (not wid1) (setq wid1 0.0))
(lp0)
(while loop
(setq loop nil)
(if (or (= var pvar) (and (= pbran bran) (= bran t)) (and (not pvar) (= pt1 pt2)))
(progn
(initget "Branchs Width Continue Endline")
(setq pt3 (getpoint pt2 "\n[Branchs/Width/Continue/Endline]? "))
)
(progn
(initget "Branchs Undo Width Continue Endline")
(setq pt3 (getpoint pt2 "\n[Branchs/Width/Undo/Continue/Endline]? "))
)
)
(cond
((= pt3 "Width")
(setq wid2 (lo1 wid1))
(setq loop t)
)
((not pt3))
((= pt3 "Branchs")
(lp1)
(setq loop t)
)
((= pt3 "Undo")
(command "undo" "1")
(cond
(bran
(setq var pvar)
(mapcar 'set (list 'dl1 'pt1 'pt2) var)
(mapcar 'set (list 'wid1 'ang1) (cddr dl1))
(setq wid2 wid1)
(ifun5)
(setq loop t)
)
((not pvar)
(setq var nil)
(lp0)
)
(t
(setq var pvar)
(mapcar 'set (list 'dl1 'pt1 'pt2) var)
(mapcar 'set (list 'wid1 'ang1) (cddr dl1))
(setq wid2 wid1)
(setq loop t)
)
)
)
((= pt3 "Continue") (setq pbran nil) (contf))
((= pt3 "Endline") (endl dl1))
(t
(setq pbran bran)
(setq bran nil)
(setq pvar var)
(command "undo" "g")
(setq var (nextd dl1 pt2 pt3 wid2 "Middle"))
(if (not (equal (sin (- (nth 3 (car var)) (nth 3 dl1))) 0.0 0.01))
(endl dl1)
)
(command "undo" "e")
(mapcar 'set (list 'dl1 'pt1 'pt2) var)
(mapcar 'set (list 'wid1 'ang1) (cddr dl1))
(setq wid2 wid1)
(setq loop t)
)
)
)
(ducvarr-ret)
(princ)
)
(defun c:rd( / loop blpm osm wid1 wid2 ang1 ang2 pt1 pt2 pt3 pen1 pen2
dl1 dl2 toff1 toff2 rtoff lbwid bwid1 bwid2 mbwid pen pst bpta
bptb bdl1 bdl2 pbdl bdl lbdl bang bpt0 dir nub nubs pst1 pst2
lbdl pm1 pm2 def dpt dl1p4 rt1 rt2 bpta1 bpta2 bcond1 bcond2
var pvar bran pbran
nbrdl brp1 brp2 arcc parc pebdl entarc filp
)
(ducvarr-res)
(if (not wid1) (setq wid1 0.0))
(lp0)
(while loop
(setq loop nil)
(if (or (= var pvar) (and (= pbran bran) (= bran t)) (and (not pvar) (= pt1 pt2)))
(progn
(initget "Branchs Width Continue Endline")
(setq pt3 (getpoint pt2 "\n[Branchs/Width/Continue/Endline]? "))
)
(progn
(initget "Branchs Undo Width Continue Endline")
(setq pt3 (getpoint pt2 "\nBranchs/Width/Undo/Continue/Endline? "))
)
)
(cond
((= pt3 "Width")
(setq wid2 (lo1 wid1))
(setq loop t)
)
((not pt3))
((= pt3 "Branchs")
(command "undo" "g")
(initget "2 3")
(setq nubs (getkword "\nnumber of branchs:: "))
(if (not nubs)
(setq nub 2)
(setq nub (atoi nubs))
)
(princ "\nwidth of first branch:(cm or distance by 2 points)? ")
(setq bwid1 (lo2))
(if (= nub 3)
(progn
(princ "\nwidth of second branch:(cm or distance by 2 points)? ")
(setq bwid2 (lo2))
)
)
(princ "\nwidth of last branch: (cm or distance by 2 points)? ")
(setq lbwid (lo2))
(if (= nub 2)
(setq toff1 (* wid1 (/ bwid1 (+ bwid1 lbwid))))
(progn
(setq toff1 (* wid1 (/ bwid1 (+ bwid1 bwid2 lbwid))))
(setq toff2 (* wid1 (/ bwid2 (+ bwid1 bwid2 lbwid))))
)
)
(princ "\nbranch no 1 :")
(setq rtoff (- wid1 toff1))
(setq bpta (polar (enpt (nth 1 dl1)) (+ ang1 (/ pi 2)) (/ toff1 2 )))
(setq pen (polar (enpt (nth 1 dl1)) (+ ang1 (/ pi 2)) toff1))
(setq pst (polar pen ang1 (- wid1)))
(setq bdl1
(list
(progn
(command "line" pst pen "")
(entlast)
)
(nth 1 dl1)
toff1
ang1
)
)
(setq bptb (getpoint bpta "\nNext Point? "))
(setq bang (angle bpta bptb))
(if (equal ang1 bang 0.01)
(progn
(setq bpta (polar bpta (+ ang1 (/ pi 2)) (/ (- bwid1 toff1) 2)))
(setq bptb (polar bptb (+ ang1 (/ pi 2)) (/ (- bwid1 toff1) 2)))
(setq bdl (twol bpta bptb bwid1 ang1))
(if (= nub 2)
(setq mbwid (/ lbwid 2))
(setq mbwid (/ (max bwid2 lbwid) 2))
)
(setq brp1 (polar (stpt (nth 1 bdl)) ang1 mbwid))
(setq brp2 (polar (stpt (nth 0 bdl)) ang1 mbwid))
(command "line" brp1 brp2 "")
(endl bdl)
(setq arcc nil)
)
(progn
(setq bdl (twol bpta bptb bwid1 bang))
(setq arcc (fil bdl1 bdl))
(startl bdl)
(endl bdl)
)
)
(setq pbdl bdl1)
(setq parc arcc pebdl bdl)
(setq arcc nil)
(if (= nub 3)
(progn
(princ "\nbranch no 2 :")
(setq rtoff (- rtoff toff2))
(setq bpta (polar (enpt (nth 0 dl1)) (- ang1 (/ pi 2)) (- wid1 (+ toff1 (/ toff2 2 )))))
(setq bpt0 (polar bpta ang1 (- (nth 2 dl1))))
(setq bdl2 (twol bpt0 bpta toff2 ang1))
(setq bptb (getpoint bpta "nextpoint? "))
(setq bang (angle bpta bptb))
(if (equal ang1 bang 0.01)
(progn
(endl (setq bdl (twol bpta bptb bwid2 ang1)))
(setq mbwid (/ (max bwid2 lbwid) 2))
(setq brp1 (polar (stpt (nth 1 bdl)) ang1 mbwid))
(setq brp2 (polar (stpt (nth 0 bdl)) ang1 mbwid))
(command "line" brp1 brp2 "")
(if parc
(progn
(setq entarc (entget parc))
(setq filp (polar (cdr (assoc 10 entarc)) (+ 0.2 (cdr (assoc 50 entarc))) (cdr (assoc 40 entarc))))
(command "fillet" "r" "0")
(setq pkb (getvar "pickbox"))
(setvar "pickbox" 1)
(command "fillet" (cdr (assoc 11 (entget (nth 1 bdl)))) filp)
(setvar "pickbox" pkb)
)
)
)
(progn
(setq bdl (twol bpta bptb bwid2 bang))
(setq arcc (fil bdl2 bdl))
(startl bdl)
(endl bdl)
(if parc
(progn
(setq bcond1 t)
(setq pen1 (CDR (ASSOC 11 (ENTGET (nth 1 bdl2)))))
(setq pst1 (CDR (ASSOC 11 (ENTGET (nth 0 bdl1)))))
)
(progn
(setq entarc (entget arcc))
(setq filp (polar (cdr (assoc 10 entarc)) (- (cdr (assoc 51 entarc)) 0.2) (cdr (assoc 40 entarc))))
(command "fillet" "r" "0")
(setq pkb (getvar "pickbox"))
(setvar "pickbox" 1)
(command "fillet" (cdr (assoc 11 (entget (nth 0 pebdl)))) filp)
(setvar "pickbox" pkb)
)
)
)
)
(setq pbdl bdl2)
(setq pebdl bdl parc arcc)
)
)
(princ "\nLast branch :")
(setq bpta (polar (enpt (nth 0 dl1)) (- ang1 (/ pi 2)) (/ rtoff 2 )))
(setq lbdl
(list
(nth 0 dl1)
(nth 0 pbdl)
rtoff
ang1
)
)
(setq bptb (getpoint bpta "\nNext Point? "))
(setq bang (angle bpta bptb))
(if (equal ang1 bang 0.01)
(progn
(setq bpta (polar bpta (+ ang1 (/ pi 2)) (/ (- rtoff lbwid) 2)))
(setq bptb (polar bptb (+ ang1 (/ pi 2)) (/ (- rtoff lbwid) 2)))
(setq bdl (twol bpta bptb lbwid bang))
(if (= nub 2)
(setq mbwid (/ bwid1 2))
(setq mbwid (/ (max bwid2 lbwid) 2))
)
(setq brp1 (polar (stpt (nth 1 bdl)) ang1 mbwid))
(setq brp2 (polar (stpt (nth 0 bdl)) ang1 mbwid))
(command "line" brp1 brp2 "")
(if parc
(progn
(setq entarc (entget parc))
(setq filp (polar (cdr (assoc 10 entarc)) (+ 0.2 (cdr (assoc 50 entarc))) (cdr (assoc 40 entarc))))
(command "fillet" "r" "0")
(setq pkb (getvar "pickbox"))
(setvar "pickbox" 1)
(command "fillet" (cdr (assoc 11 (entget (nth 1 bdl)))) filp)
(setvar "pickbox" pkb)
)
)
)
(progn
(setq bdl (twol bpta bptb lbwid bang))
(setq pst2 (enpt (nth 1 lbdl)))
(setq arcc (fil lbdl bdl))
(startl bdl)
(if parc
(progn
(setq bcond2 t)
(setq pen2 (enpt (nth 1 lbdl)))
)
(progn
(setq entarc (entget arcc))
(setq filp (polar (cdr (assoc 10 entarc)) (- (cdr (assoc 51 entarc)) 0.2) (cdr (assoc 40 entarc))))
(command "fillet" "r" "0")
(setq pkb (getvar "pickbox"))
(setvar "pickbox" 1)
(command "fillet" (cdr (assoc 11 (entget (nth 0 pebdl)))) filp)
(setvar "pickbox" pkb)
)
)
)
)
(endl dl1)
(entdel (nth 1 lbdl))
(if bcond2
(progn
(command "line" pst2 pen2 "")
(setq bcond2 nil)
)
)
(if (= nub 3)
(progn
(entdel (nth 1 pbdl))
(entdel (nth 0 bdl1))
(if bcond1
(progn
(command "line" pst1 pen1 "")
(setq bcond1 nil)
)
)
)
)
(command "undo" "e")
(setq pvar var)
(setq var (list bdl bpta bptb))
(mapcar 'set (list 'dl1 'pt1 'pt2) var)
(mapcar 'set (list 'wid1 'ang1) (cddr dl1))
(setq wid2 wid1)
(setq loop t)
)
((= pt3 "Undo")
(command "undo" "1")
(cond
(bran
(setq var pvar)
(mapcar 'set (list 'dl1 'pt1 'pt2) var)
(mapcar 'set (list 'wid1 'ang1) (cddr dl1))
(setq wid2 wid1)
(ifun5)
(setq loop t)
)
((not pvar)
(setq var nil)
(lp0)
)
(t
(setq var pvar)
(mapcar 'set (list 'dl1 'pt1 'pt2) var)
(mapcar 'set (list 'wid1 'ang1) (cddr dl1))
(setq wid2 wid1)
(setq loop t)
)
)
)
((= pt3 "Continue") (setq pbran nil) (contf))
((= pt3 "Endline") (endl dl1))
(t
(setq pbran bran)
(setq bran nil)
(setq pvar var)
(command "undo" "g")
(setq var (nextd dl1 pt2 pt3 wid2 "Middle"))
(if (not (equal (sin (- (nth 3 (car var)) (nth 3 dl1))) 0.0 0.01))
(endl dl1)
)
(command "undo" "e")
(mapcar 'set (list 'dl1 'pt1 'pt2) var)
(mapcar 'set (list 'wid1 'ang1) (cddr dl1))
(setq wid2 wid1)
(setq loop t)
)
)
)
(ducvarr-ret)
(princ)
)
(alert "\nIgal Averbuh 2016 Duct Drawing program loaded.\nDedicated to TOPAZ Bareket LTD")
(princ "\nEnter [SD] for supply duct")
(princ)
(c:sd)

Advertisements