Request for Lisp to draw Duct Elbow

[LSA]

I would be thankful if someone would like to share their lisp for creating duct elbows (both round & rectangular).

 

For those that are not in the HVAC field...I would like to request a lisp that would draw:

 

 

 

Sorry for the super large picture. I didnt have a chance to resize it.

 

So the lisp would prompt for a start point. (preferably a mid snap)

Prompt for diameter.

Prompt for the radius. (If radius is 1 then the inner radius equals the diameter, the outter radius is equal to inner radius + diamter. If radius is 1.5 then the inner radius is 1.5 times the diameter and so on.)

 

 

Thanks in advance.

 

LSA

[fuccaro]

What software do you use? Probable it can be donne with a dynamic block.

[LSA]

I use ACAD 2006. Can you eleborate on how this can be done with dynamic blocks?

 

I was under the impression that dynamics blocks are just blocks that one can edit without exploding them. Are you referring to using the tools pallette?

[Adesu]

I would be thankful if someone would like to share their lisp for creating duct elbows (both round & rectangular).

 

For those that are not in the HVAC field...I would like to request a lisp that would draw:

 

So the lisp would prompt for a start point. (preferably a mid snap)

Prompt for diameter.

Prompt for the radius. (If radius is 1 then the inner radius equals the diameter, the outter radius is equal to inner radius + diamter. If radius is 1.5 then the inner radius is 1.5 times the diameter and so on.)

 

Thanks in advance.

 

LSA

 

Hi LSA,

here my code,I just create special for you,and test it

(defun c:test (/ loc rad p1 p2 el1 dia p3 el2 p4 el3 el4)
 (setq loc (getpoint "\nClick any location for object<0,0,0>: "))
 (if (= loc nil)(setq loc '(0 0 0)))
 (setq rad (getdist "\nEnter radius for duct<1>: "))
 (if (= rad nil)(setq rad 1))
 (setq p1 (polar loc 0 rad))
 (setq p2 (polar loc (* pi 0.5) rad))
 (command "_arc" "c" loc p1 p2 "")  
 (setq el1 (entlast))
 (setq dia (getdist "\nEnter diameter for duct<2>: "))
 (if (= dia nil)(setq dia 2))
 (setq p3 (polar p1 0 dia))
 (command "_offset" dia el1 p3 "")
 (setq el2 (entlast))
 (setq p4 (polar p2 (* pi 0.5) dia))
 (command "_line" p1 p3 "")
 (setq el3 (entlast))
 (command "_line" p2 p4 "")
 (setq el4 (entlast))
 (command "_region" el1 el2 el3 el4 "")
 (princ)
 )  

[fixo]

This work for me in A2005:

 

(defun C:duct (/ bpt cpt dia pt rad tpt ulp urp x y)
 (setvar "cmdecho" 0)
 (setvar "osmode" 0)

 (setq    dia (getreal "\nEnter diameter :\n")
   rad (getreal "\nEnter duct radius as diameter fraction : \n")
 )

 (setq pt (getpoint "\nEnter insertion point of duct \n"))
 (setq    x   (car pt)
   y   (cadr pt)
   bpt (list x (- y (/ dia 2)))
   tpt (list x (+ y (/ dia 2)))
   cpt (list x (+ y (+ (* dia 0.5) (* dia rad))))
   ulp (list (+ x (* dia rad)) (+ y (* dia 0.5) (* dia rad)))
   urp (list (+ x dia (* dia rad)) (+ y (* dia 0.5) (* dia rad)))
 )

 (command "arc"  "C"     cpt    tpt    ulp    "arc"  "C"    cpt
      bpt      urp     "line"    tpt    bpt    ""     "line" urp
      ulp      ""
     )
 (setvar "osmode" 703)
 (setvar "cmdecho" 1)
 (princ)
)
;Test : (C:duct)

~'J'~

[LSA]

Thanks guys. Both worked fine. I will tweak it alittle to suit my needs.

[hyposmurf]

Heres a pretty cool one, will draw your ductowrk route with corners. I understand how cumbersome it is to draw corners for ductwork,pretty time consuming and our block library is a bit useless to.I think Ive got some other ductwork lisps about on my PC here to.

 

(defun c:rdrc (/      ip     rcl1   rcl2   rcl3   rcl4      rcl5     rcl6
       rcl7   rcl8   rcl9   rcl10  rcl11  rcl12  rcl13     rcl14
       rcl15  rcl16  rcl17  rcl18  rcl19  rcl20  d1     d3
       d125   h2     d325   d375   se       se1      l     h
       a90    a180   a270
          )
   (progn
   (command "_undo" "m")
     ;;BASED ON HOTCHKISS TECH MANUAL TYPE RCL
     (prompt "\nCommand - Hotchkiss [RCL] Rectangular Reducer ")
     (setvar "cmdecho" 0)
     (setq osm (getvar "osmode"))
     (setvar "osmode" 0)
     (command "highlight" 0)
     (setq clay (getvar "clayer"))
     (setq elay1 (tblsearch "layer" "d-general"))
     (if (= elay1 nil)
   (command "layer" "m" "d-general" "c" "8" "" "")
     )
     (setq elay2 (tblsearch "layer" "d-hidden"))
     (if (= elay2 nil)
   (command "layer" "m" "d-hidden" "c" "8"  "" "lt" "hidden2" "" "")
     )
     (setq elay3 (tblsearch "layer" "d-centre"))
     (if (= elay3 nil)
   (command "layer" "m" "d-centre" "c" "8"  "" "lt" "center2" "" "")
     )
     (command "layer" "s" "0" "")
     ;;GET VARIABLES FROM USER
     (setq dio (getvar "userr2"))
     (setq d1 (getdist    (strcat    "\nEnter Rectangular Duct Width <"
               (rtos (getvar "userr2") 2 2)
               "mm> "
           )
          )
     )

     (if (= d1 nil)
   (setq d1 dio)
     )

     (setq dii (getvar "userr2"))
     (setq d2 (getdist "\nEnter New Duct Width :"))
     (if (= d2 nil)
   (setq d2 dii)
     )
     (command "setvar" "userr2" d2)
     ;;SET CONSTANTS
     (setq a22 (* (/ 22.500 180) Pi))
     (setq a90 (* (/ 90.000 180) Pi))
     (setq a180 (* (/ 180.000 180) Pi))
     (setq a270 (* (/ 270.000 180) Pi))
     (setq d150 (* 0.50 d1))
     (setq d250 (* 0.50 d2))
     (setq sina (sin a22))
     (setq cosa (cos a22))

     ;;SET SE DIMENSION
     (if (< d2 226)
   (setq se 40)
     )
     (if (and (< d2 316) (> d2 225))
   (setq se 60)
     )
     (if (> d2 317)
   (setq se 75)
     )
     ;;SET SE1 DIMENSION
     (if (< d1 226)
   (setq se1 40)
     )
     (if (and (< d1 316) (> d1 225))
   (setq se1 60)
     )
     (if (> d1 317)
   (setq se1 75)
     )
     ;;SET L DIMENSION
     (setq dif1 (- d1 d2))
     (setq dif2 (/ dif1 2))
     (setq dif3 (/ dif2 sina))
     (setq l (* dif3 cosa))
     (if (<= dif1 20)
   (setq l 75)
     )
     ;;CREATE BLOCKNAME
     (setq fa (itoa (fix d1)))
     (setq fb (itoa (fix d2)))
     ;;(setq fc (itoa (fix l)))
     (setq bnrcl (strcat "rdrc" "-" fa "-" fb))
     ;;CREATE PARAMETRIC POINTS
     (setq ip
        (getpoint
          "\nPick Insertion point (or HIT RETURN IF ADDING TO DUCT) :"
        )
     )
     (if (= ip nil)
   (setq ip p3)
     )
     (setq rcl1 (polar ip a90 d150))
     (setq rcl2 (polar rcl1 a180 se1))
     (setq rcl3 (polar rcl2 a270 d1))
     (setq rcl4 (polar rcl3 0 se1))
     (setq rcl5 (polar ip 0 l))
     (setq rcl6 (polar rcl5 a90 d250))
     (setq rcl7 (polar rcl6 0 se))
     (setq rcl8 (polar rcl7 a270 d2))
     (setq rcl9 (polar rcl8 a180 se))
     ;;DRAW CONICAL REDUCER
     (command "layer" "s" "d-general" "" "")
;;;      (command "color" "8")
     (command "line" rcl1 rcl4 "")
     (setq apt (ssget "l"))
     (command "line" rcl6 rcl9 "")
     (setq ast (entlast))
     (ssadd ast apt)
     (command "linetype" "s" "BYLAYER" "")
     (command "layer" "s" "0" "" "")
;;;      (command "color" "bylayer")
     (command "line" rcl2 rcl3 "")
     (setq ast (entlast))
     (ssadd ast apt)
     (command "line" rcl7 rcl8 "")
     (setq ast (entlast))
     (ssadd ast apt)
;;;      (command "linetype" "s" "bylayer" "")
     (command "layer" "s" "0" "" "")
;;;      (command "color" "byblock")
     (command "line" rcl1 rcl6 "")
     (setq ast (entlast))
     (ssadd ast apt)
     (command "line" rcl4 rcl9 "")
     (setq ast (entlast))
     (ssadd ast apt)
     ;;CREATE BLOCK
     (setq tbl (tblsearch "block" bnrcl))
     (if (= tbl nil)
   (command "block" bnrcl ip apt "")
   (command "erase" apt "")
     )
     ;;INSERT BLOCK
     (command "layer" "s" clay "")
     (if (= dang nil)
   (setq dang 0)
     )
     (setq ep (polar ip (/ (* dang Pi) 180) l))
     (command "insert" bnrcl ip "" "" dang)
     (setvar "osmode" osm)
     (command "highlight" 1)
     ;;END
 (command "rotate" "l" "" ip)
   )
)

LSA any chance you could shrink that image down a bit its humungous, makes it hard to read the post.

[LSA]

Thanks Hsmurf. Although I am only able to draw straight ductwork and transitions with your lisp.

 

Am I missing something?

 

BTW, i resized the pic but its not very readable anymore.

[fuccaro]

Can you eleborate on how this can be done with dynamic blocks?

Read HERE my answer to a similar question.

 

BTW, i resized the pic but its not very readable anymore.

I would crop the image. The margins are so width and holding no info.

[hyposmurf]

Thanks Hsmurf. Although I am only able to draw straight ductwork and transitions with your lisp.

 

Am I missing something?

 

BTW, i resized the pic but its not very readable anymore.

 

You sure are missing the right one, shouldve been in bed not surfing the forum at that time. Heres what I meant to post.hope it makes up for it.

 

 

I have no idea where the code came from, but its a great little piece and thanks to the creator.

 

(defun c:rdcb ()
   (progn
     (prompt "\nCommand - Rectangular Ductwork With Radius Bends"
     )
     (setvar "cmdecho" 0)
     (setq osm (getvar "osmode"))
     (setvar "osmode" 0)
     (command "highlight" 0)
     (command "ucs" "w")
     ; Convert value in radians to degrees
     (setq a90 (* (/ 90.000 180) Pi))
     (setq a180 (* (/ 180.000 180) Pi))
     (setq a269 (* (/ 269.999 180) Pi))
     (setq a270 (* (/ 270.000 180) Pi))
     (setq a360 (* (/ 360.0000 180) Pi))
     ;;SET Di1 AND Di2

     (setq dio (getvar "userr2"))
     (setq di1    (getdist (strcat "\nEnter Rectangular Duct Width <"
                (rtos (getvar "userr2") 2 2)
                "mm> "
            )
       )
     )

     (if (= di1 nil)
   (setq di1 dio)
     )
     (command "setvar" "userr2" di1)


     (setq di2 (/ di1 2.00))
     ;;SET SE DISTANCE
     (if (< di1 226)    (setq se 40)
     )
     (if (and (< di1 316) (> di1 225))
   (setq se 60)
     )
     (if (> di1 349)
   (setq se 75)
     )
     (setq p1
        (getpoint "\nPick 1st Point (OR HIT RETURN FOR LAST POINT) "
        )
     )
     (if (= p1 nil)
   (setq p1 ep)
     )
     (setq p2 (getpoint p1 "\nPick Next Point :"))
     (setq p3 (getpoint p2 "\nPick Next Point :"))
     (command "linetype" "s" "centerx2" "")
     (command "color" "8")
     ;;DRAW LINE L1
     (command "line" p1 p2 "")
     (setq l1 (entlast))
     ;;DRAW LINE L2
     (command "line" p2 p3 "")
     (setq l2 (entlast))
     ;;CREATE ARC C1
     (command "filletrad" di1)
     ;;FILLET CENTRE LINES L1 L2
     (command "fillet" l1 l2)
     (setq c1 (entlast))
     (setq ce1 (entget c1))
     (setq c110 (cdr (assoc 10 ce1)))
     (setq c150 (cdr (assoc 50 ce1)))
     (setq c151 (cdr (assoc 51 ce1)))
     ;;CREATE LINES CL1 CL2
     (command "linetype" "s" "hiddenx2" "")
     ;;CL1
     (setq cp1 (polar c110 c150 di2))
     (setq cp2 (polar c110 c150 (* 1.5 di1)))
     (command "line" cp1 cp2 "")
     (setq cl1 (entlast))
     ;;CL2
     (setq cp3 (polar c110 c151 di2))
     (setq cp4 (polar c110 c151 (* 1.5 di1)))
     (command "line" cp3 cp4 "")
     (setq cl2 (entlast))
     ;;CL3
     (setq cl2a (entget cl2))
     (setq d4 (cdr (assoc 10 cl2a)))
     (setq e4 (cdr (assoc 11 cl2a)))
     (setq ang (angle d4 e4))
     (setq ang1 (+ ang A90))
     (setq ang2 (- ang A90))
     (setq lin (polar d4 ang1 se))
     (command "copy" cl2 "" d4 lin)
     (setq cl3 (entlast))
     ;;CL4
     (setq cl1a (entget cl1))
     (setq d3 (cdr (assoc 10 cl1a)))
     (setq e3 (cdr (assoc 11 cl1a)))
     (setq ang (angle d3 e3))
     (setq ang1 (+ ang A90))
     (setq ang2 (- ang A90))
     (setq lin1 (polar d3 ang2 se))
     (command "copy" cl1 "" d3 lin1)
     (setq cl4 (entlast))
     (command "change" cl1 cl2 "" "p" "lt" "bylayer" "")
     ;;CREATE OUTER AND INNER LINES L2a L2b
     (setq le2 (entget l2))
     (setq d2 (cdr (assoc 10 le2)))
     (setq e2 (cdr (assoc 11 le2)))
     (setq ang (angle d2 e2))
     (setq dang (angle p2 p3))
     (setq dang (/ (* dang 180) Pi))

     (setq ang1 (+ ang A90))
     (setq ang2 (- ang A90))
     (setq lin (polar d2 ang1 di2))
     (setq lin1 (polar d2 ang2 di2))
     (command "copy" l2 "" d2 lin)
     (setq l2a (entlast))
     (command "copy" l2 "" d2 lin1)
     (setq l2b (entlast))
     ;;CREATE OUTER AND INNER LINES L1a L1b
     (setq le1 (entget l1))
     (setq d1 (cdr (assoc 10 le1)))
     (setq e1 (cdr (assoc 11 le1)))
     (setq ang (angle d1 e1))
     (setq ang1 (+ ang A90))
     (setq ang2 (- ang A90))
     (setq lin (polar d1 ang1 di2))
     (setq lin1 (polar d1 ang2 di2))
     (command "copy" l1 "" d1 lin)
     (setq l1a (entlast))
     (command "copy" l1 "" d1 lin1)
     (setq l1b (entlast))
     (command "change"    l1a     l1b      l2a       l2b        ""
          "p"    "c"     "bylayer"       "lt"        "bylayer"
          ""
         )
     ;;CREATE ARCS C2 C3
     (command "linetype" "s" "bylayer" "")
     (command "color" "bylayer")
     (command "arc" cp2 "c" c110 cp4)
     (setq c2 (entlast))
     (command "arc" cp1 "c" c110 cp3)
     (setq c3 (entlast))
     (setvar "osmode" osm)
     (command "ucs" "p")
     (command "highlight" 1)
     (command "erase" l1 l2 c1 "")
     (setq ep p3)
     ;;END
   )
)

Just seen you other threads on drawing double line. Nice to meet someone else in the same HVAC industry using CAD.

[LSA]

HSmurf....nice lisp. Very much appreciated.

[hyposmurf]

If youve got any HVAC lisps yourself that youd like to share thatd be cool .I tried to start a thread on here for HVAC lisps but didnt get much of a response.

[monk]

The lisp code posted has the formatting of this changed? Could you possibly send me the lisp file?

[fixo]

Here is it

 

~'J'~

hyposmurph_duct.lsp

[monk]

Thanks for your quick reply! Finally a lisp that includes small ends! im guessing you dont have a version that includes centre lines?

 

Im a novice lisp writer, which sucks! I really want to start writing things that suit my needs.

[monk]

In regard to my last post, i found you erase the centre line at the end of the lisp. I have just removed that line. Works great small ends and centre line!

*Wishes it did more than 2 lines*

[fixo]

Glad you got it to work

Cheers

 

~'J'~

[me08029]

I would be thankful if someone would like to share their lisp for creating

[farfarir]

I think you should use a lisp and use them ability

[devitg]

Hi Fixo , it have a long time since our last meet.

 

Please contact me