I have an Equation to find the Duct reducer length. Can Lisp calculate it and draw the reducer automatically?
Can lisp calculate and draw with reference to formulae ?
AutoLisp can certainly calculate that. The length of the reducer would be:
(+ (* 1.73 (abs (- w1 w2))) 70)
[I used (abs) so that it doesn't matter whether w1 or w2 is the greater width.]
Having it draw that is another issue, but should be possible. But questions arise:
Is the transition always flush on one side as in your example, or might transitions occur narrowing or widening on both sides?
Should it shorten the [in your example] bottom line on the right or on the left, or [for example] always the one on the narrower-duct side, or both equally, or...?
[I think we can assume that ducts will run in all directions, not always horizontally.]
What would be your expected procedure? Call the command, and then.... Pick existing things? Draw it all from scratch? Etc.
Consider using a Dynamic Block.
Kent Cooper, AIA 
Accepted solution
Try this
(defun c:reducer (/ txt1 txt2 p1 p2 svnames r_len side)
(if (not (tblsearch "LAYER" "Reducer"))(command "-layer" "m" Reducer "p" "p" Reducer "c" 2 Reducer ""))
(if (setq txt1 (vla-get-TextString (vlax-ename->vla-object (car (entsel "\nPick text 1st value")))))
(princ (strcat "\nPipe 1 -" (rtos (atof txt1))))
)
(if (setq txt2 (vla-get-TextString (vlax-ename->vla-object (car (entsel "\nPick text 2nd value")))))
(princ (strcat "\nPipe 1 -" (rtos (atof txt2))))
)
(or side (setq side "ONE"))
(initget "ONE TWO")
(if (setq tmp (getstring (strcat "\nType of reducer [ONE / TWO] <" side ">: ")))
(setq side tmp)
)
(setq p1 (getpoint "\nSpecify place point: "))
(setq svnames '(osmode cmdecho) svvals (mapcar 'getvar svnames))
(mapcar 'setvar svnames '(0 0))
(setq txt1 (atof txt1) txt2 (atof txt2))
(cond
( (eq side "ONE")
(setq r_len (+ (* 1.73 (abs (- txt1 txt2))) 70))
(princ r_len)
(LWPoly
(list
(polar p1 (DTR 270) txt1)
(polar p1 (DTR 0) 0)
(setq p2 (polar p1 (DTR 0) r_len))
(polar p2 (DTR 270) txt2)
)
1
)
)
( (eq side "TWO")
(setq r_len (+ (* 0.87 (abs (- txt1 txt2))) 70))
(princ r_len)
(setq p2 (polar (polar p1 (DTR 270) (/ txt1 2)) (DTR 0) r_len))
(LWPoly
(list
(polar p1 (DTR 270) txt1)
(polar p1 (DTR 0) 0)
(polar p2 (DTR 90) (/ txt2 2))
(polar p2 (DTR 270) (/ txt2 2))
)
1
)
)
)
(mapcar 'setvar svnames svvals)
(princ)
)
(defun DTR (a)(* PI (/ a 180.0)))
(defun LWPoly (lst cls)
(entmakex (append (list (cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 8 "Reducer")
(cons 90 (length lst))
(cons 70 cls);flag for polyline type 0 = open 1 = closed
)
(mapcar (function (lambda (p) (cons 10 p))) lst)
)
)
)
Accepted solution
Now,
It works angle line and Polyline.
and you can input O & T
I can not understand with "Sub duct" , If you upload your drawing, I can try to fix it.
Thank you very much for the updated lisp.
what I mean by the subduct, when we insert the reducer there will be a gap bw reducer and a smaller duct. Is there any automation possible to extend it till the reducer that we have made?
in the ss i have marked it by yellow polyline
one more question, If the one-side reducer is on the bottom side, can we include any mirror option in the lisp?
I found this “EE” LISP somewhere internet since I am using this for a long time, I am very familiar with and very good use this. As I am a very beginner to LISP. I can't understand what kind of logic is used in this. Still, I wish to ask if you can modify this LISP for our reducer purpose.
(defun c:EE()
(setvar "osmode" 512)
(prompt "\nPick Outer Side of Main Duct: ")
(setq en1: (entsel))
(prompt "\nPick Inner Side of Main Duct: ")
(setq en2: (entsel))
(prompt "\nPick Inner Side of Branch Duct: ")
(setq en3: (entsel))
(prompt "\nPick Outer Side of Branch Duct: ")
(setq en4: (entsel) CFM:M 1)
(setvar 'osmode 5375 )
(M:EE EN1: EN2: EN3: EN4: CFM:M 1 r_o_d:1)
)
(DEFUN M:EE (EN_:1 EN_:2 EN_:3 EN_:4 CFM:B? EN?:1 r_o_d:)
(setq r_o_d: 0.75)
(setq rod:d (- r_o_d: 0.5))
(setq x "en1:" EN_:1 (m:LSPR EN_:1))
(setq x "en2:" EN_:2 (m:LSPR EN_:2))
(setq x "en3:" EN_:3 (m:LSPR EN_:3))
(setq x "en4:" EN_:4 (m:LSPR EN_:4))
(setq pos: (inters en3:p1 en3:p2 en2:p1 en2:p2)
pos: (if pos: (inters en3:p1 en3:p2 en2:p1 en2:p2)
(inters en3:p1 en3:p2 en2:p1 en2:p2 nil)
)
)
(setvar "lastpoint" pos:)
(setq dum:1 (osnap en1:pp "perp")
dum:2 (osnap en4:pp "perp")
wMAN: (distance pos: dum:1) W1 (/ WMAN: (/ CFM:M CFM:B?))
w2 (distance pos: dum:2)
rd:x (max w1 w2) rd:n (min w1 w2)
a:1 (angle pos: en2:pp)
a:2 (angle pos: en3:pp)
a:2p (angle pos: dum:2)
a:1p (angle pos: dum:1)
ang:1 (- a:2 a:1) ang:12 (/ ang:1 2)
dum:1 (abs (* rod:d rd:x (/ (cos ang:12) (sin ang:12))))
en2:pp (polar pos: a:1 dum:1)
en3:pp (polar pos: a:2 dum:1)
arc:1 (polar en2:pp a:1p (- (* rod:d rd:x)))
en1:pp (polar en2:pp a:1p w1)
en4:pp (polar en3:pp a:2p w2)
rd:2 (+ (* rod:d rd:x) (* (+ (* rd:x (cos ang:1)) rd:n) (sin ang:12) (/ 1 (cos ang:12)) (/ 1 (sin ang:1))))
m: (if (minusp (- a:2p a:1p)) (setq m: 1) (setq m: -1))
arc:2 (if (< w1 w2) (polar en4:pp a:2p (- rd:2)) (polar en1:pp a:1p (- rd:2)))
drw:a (* (atof (angtos (abs (- a:2p a:1p)))) m:)
)
(if (> (abs drw:a) 180) (setq drw:a (* (- 360 (abs drw:a)) (- m:))))
(setq pos:1 (inters en1:p1 en1:p2 en4:p1 en4:p2)
pos:1 (if pos:1 (inters en1:p1 en1:p2 en4:p1 en4:p2)
(inters en1:p1 en1:p2 en4:p1 en4:p2 nil)
)
)
(m:odif en_:2 a:1 en2:p1 en2:p2 en2:pp pos:)
(m:odif en_:3 a:2 en3:p1 en3:p2 en3:pp pos:)
(IF EN?:1 (m:odif en_:1 a:1 en1:p1 en1:p2 en1:pp pos:1))
(m:odif en_:4 a:2 en4:p1 en4:p2 en4:pp pos:1)
(if (< w1 w2) (command "pline" en1:pp en2:pp "a" "ce" arc:1 "a" (- drw:a) "l" en4:pp "a" "ce" arc:2 "a" drw:a "l" "cl")
(command "pline" en4:pp en3:pp "a" "ce" arc:1 "a" drw:a "l" en1:pp "a" "ce" arc:2 "a" (- drw:a) "l" "cl")
)
(if (< w1 w2) (setq a: a:2p) (setq a: a:1p))
(IF (= MVAN:? "ON")(M:VANE))
)
(defun m:lspr (entt:)
(setq y (car entt:))
(set (read (strcat x "p1")) (cdr (assoc 10 (entget y))))
(set (read (strcat x "p2")) (cdr (assoc 11 (entget y))))
(set (read (strcat x "pp")) (cadr entt:))
(setq xp1 (car (cdr (assoc 10 (entget y))))
yp1 (cadr (cdr (assoc 10 (entget y))))
xp2 (car (cdr (assoc 11 (entget y))))
yp2 (cadr (cdr (assoc 11 (entget y))))
)
(if (not (> (abs (- xp1 xp2)) 0.00001))(progn
(setq xpp xp1 ynpp (cadr (cadr entt:))))
(progn
(setq slpp (/ (- yp2 yp1) (- xp2 xp1))
bpp (- yp1 (* slpp xp1))
xpp (car (cadr entt:))
ynpp (+ (* slpp xpp) bpp)
)
)
)
(set (read (strcat x "pp")) (list xpp ynpp))
(setQ X Y)
)
(defun m:odif (entt: ang: p1 p2 p3 p4)
(setq entt: (entget entt:))
(IF (or (= (rtos (angle p4 p3) 2 4) (rtos (angle p4 p1) 2 4)) (= (rtos (angle p4 p3) 2 4) (rtos (- (angle p4 p1) pi pi) 2 4))) (setq ch:1 p1 ch:2 p3) (setq ch:1 p2 ch:2 p3))
(if (and (= (rtos (angle p4 p1) 2 4) (rtos (angle p4 p2) 2 4)) (< (distance p4 p1) (distance p4 p2))) (setq ch:1 p2))
(setq entt: (subst (cons 10 ch:2) (cons 10 p1) entt:)
entt: (subst (cons 11 ch:1) (cons 11 p2) entt:)
)
(ENTMOD ENTT:)
)
