Jump to content

Duct elbow

mdbdesign

By mdbdesign
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

mdbdesign Experienced

mdbdesign

Posted
Posted

We got large project for aluminum duct system ranging Ø from 100 to 1000 mm involving lots of elbows My question is: is there somewhere lisp that can draw side view of elbow with only user input as: duct OD, # of segments and elbow degree.

Please help:)

  • Replies 33
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    13

  • mdbdesign

    9

  • Buggsy

    3

  • rbeldua

    2

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

Lee Mac Grand Master

Lee Mac

Posted
Posted

Try this for starters:

 

(defun c:duct (/ *error* oVars vLst dPt dOd Segs dAng vEnt i PntEve PntOdd
            cAngE sPtE ePtE cAngO sPtO ePtO last_pt1 last_pt2)
 (defun *error* (msg)
   (if oVars (mapcar 'setvar vLst oVars))
   (princ (strcat "\nError: " (strcase msg))) (princ))
 (setq vLst '("CMDECHO" "OSMODE")
   oVars (mapcar 'getvar vLst))
 (if (and (setq dPt (getpoint "\nSelect Point for Elbow: "))
      (not (initget 7)) (setq dOd (getdist "\nSpecify Duct OD: "))
      (not (initget 7)) (setq Segs (getint "\nSpecify No. of Segments: "))
      (setq dAng (getreal "\nSpecify Elbow Angle: ")) (< 0 dAng 360))
   (progn
     (mapcar 'setvar vlst '(0 0))
     (command "_arc" "_C" (polar dPt (/ pi 2) dOd) dPt "_A" (rtos dAng))
     (setq vEnt (vlax-ename->vla-object (entlast)) i 0.0 inc (/ (vla-get-ArcLength vEnt) Segs))
     (while (or  (setq PntEve (vlax-curve-GetPointatDist vEnt i)
           PntOdd (vlax-curve-GetPointatDist vEnt (setq i (+ inc i)))))
   (setq cAngE (+ (/ pi 2) (angle '(0 0 0) (vlax-curve-getFirstDeriv vEnt
                        (vlax-curve-GetParamAtPoint vEnt PntEve)))))
   (command "_line" (setq sPtE (polar PntEve cAngE 4.0)) (setq ePtE (polar PntEve (+ pi cAngE) 4.0)) "")
   (if (and last_pt1 last_pt2) (progn (command "_line" last_pt1 sPtE "") (command "_line" last_pt2 ePtE "")))
   (setq cAngO (+ (/ pi 2) (angle '(0 0 0) (vlax-curve-getFirstDeriv vEnt
                        (vlax-curve-GetParamAtPoint vEnt PntOdd)))))
   (command "_line" (setq sPtO (polar PntOdd cAngO 3.0)) (setq ePtO (polar PntOdd (+ pi cAngO) 3.0)) "")
   (command "_line" sPtE sPtO "") (command "_line" ePtE ePtO "")
   (setq last_pt1 sPtO last_pt2 ePtO)
   (setq i (+ inc i)))
     (vla-put-Color vEnt acblue))
   (princ "\n<!> Points Specified Incorrectly <!>"))
 (mapcar 'setvar vLst oVars)
 (princ))

Lee Mac Grand Master

Lee Mac

Posted
Posted

My apologies, this is better:

 

(defun c:duct  (/ *error* oVars    vLst dPt dOd Segs dAng vEnt i PntEve
          PntOdd cAngE sPtE ePtE cAngO sPtO ePtO last_pt1 last_pt2)
 (defun *error*  (msg)
   (if    oVars (mapcar 'setvar vLst oVars))
   (princ (strcat "\nError: " (strcase msg))) (princ))
 (setq    vLst  '("CMDECHO" "OSMODE")
   oVars (mapcar 'getvar vLst))
 (if (and (setq dPt (getpoint "\nSelect Point for Elbow: "))
      (not (initget 7)) (setq dOd (getdist "\nSpecify Duct OD: "))
      (not (initget 7)) (setq Segs (getint "\nSpecify No. of Segments: "))
      (setq dAng (getreal "\nSpecify Elbow Angle: ")) (< 0 dAng 360))
   (progn
     (mapcar 'setvar vlst '(0 0))
     (command "_arc" "_C" (polar dPt (/ pi 2) (* 1.5 dOd)) dPt "_A" (rtos dAng))
     (setq vEnt (vlax-ename->vla-object (entlast)) i 0.0 inc (/ (vla-get-ArcLength vEnt) Segs))
     (while (setq PntEve (vlax-curve-GetPointatDist vEnt i))
   (setq cAngE (+ (/ pi 2) (angle '(0 0 0) (vlax-curve-getFirstDeriv vEnt
               (vlax-curve-GetParamAtPoint vEnt PntEve)))))
   (command "_line" (setq sPtE (polar PntEve cAngE (/ (+ dOd (* inc 2.0)) 2.0)))
        (setq ePtE (polar PntEve (+ pi cAngE) (/ (+ dOd (* inc 2.0)) 2.0))) "")
   (if (and last_pt1 last_pt2) (progn (command "_line" last_pt1 sPtE "") (command "_line" last_pt2 ePtE "")))
   (if (setq PntOdd (vlax-curve-GetPointatDist vEnt (setq i (+ inc i))))
     (progn
       (setq cAngO    (+ (/ pi 2) (angle '(0 0 0) (vlax-curve-getFirstDeriv vEnt
                             (vlax-curve-GetParamAtPoint vEnt PntOdd)))))
       (command "_line" (setq sPtO (polar PntOdd cAngO (/ dOd 2.0)))
            (setq ePtO (polar PntOdd (+ pi cAngO) (/ dOd 2.0))) "")
       (command "_line" sPtE sPtO "") (command "_line" ePtE ePtO "")
       (setq last_pt1 sPtO last_pt2 ePtO i (+ inc i)))))
     (vla-put-Color vEnt acblue))
   (princ "\n<!> Points Specified Incorrectly <!>"))
 (mapcar 'setvar vLst oVars)
 (princ))

Lee Mac Grand Master

Lee Mac

Posted
Posted

Not restrictions, I just thought you wanted ducting like this:

Duct.jpg

Lee Mac Grand Master

Lee Mac

Posted
Posted

Ok, I've given you an "adjustment menu" at the top of the LISP, play around with it til your hearts content :)

 

(defun c:duct  (/ *error* oVars    vLst dPt dOd Segs dAng vEnt i PntEve PntOdd
         cAngE sPtE ePtE cAngO sPtO ePtO last_pt1 last_pt2 Cent str)

 ;; ==== Adjustments ====

 (setq Cent T) ; Duct Centreline

 (setq str T) ; Straight/Corrugated Duct (T = Straight, nil = Corrugated)

 ;; =====================


 (defun *error*  (msg)
   (if    oVars (mapcar 'setvar vLst oVars))
   (princ (strcat "\nError: " (strcase msg)))
   (princ))
 (setq    vLst  '("CMDECHO" "OSMODE")
   oVars (mapcar 'getvar vLst))
 (if (and (setq dPt (getpoint "\nSelect Point for Elbow: "))
      (not (initget 7))
      (setq dOd (getdist "\nSpecify Duct OD: "))
      (not (initget 7))
      (setq Segs (getint "\nSpecify No. of Segments: "))
      (setq dAng (getreal "\nSpecify Elbow Angle: "))
      (< 0 dAng 360))
   (progn
     (mapcar 'setvar vlst '(0 0))
     (or (and str (setq j 0.0)) (setq j 1.0))
     (command "_arc" "_C" (polar dPt (/ pi 2) (* 1.5 dOd)) dPt "_A" (rtos dAng))
     (setq vEnt (vlax-ename->vla-object (entlast))
       i     0.0
       inc     (/ (vla-get-ArcLength vEnt) Segs))
     (while (setq PntEve (vlax-curve-GetPointatDist vEnt i))
   (setq cAngE (+ (/ pi 2) (angle '(0 0 0) (vlax-curve-getFirstDeriv vEnt
               (vlax-curve-GetParamAtPoint vEnt PntEve)))))
   (command "_line" (setq sPtE (polar PntEve cAngE (/ (+ dOd (* j inc 2.0)) 2.0)))
        (setq ePtE (polar PntEve (+ pi cAngE) (/ (+ dOd (* j inc 2.0)) 2.0))) "")
   (if (and last_pt1 last_pt2)
     (progn (command "_line" last_pt1 sPtE "") (command "_line" last_pt2 ePtE "")))
   (if (setq PntOdd (vlax-curve-GetPointatDist vEnt (setq i (+ inc i))))
     (progn
       (setq cAngO    (+ (/ pi 2) (angle '(0 0 0) (vlax-curve-getFirstDeriv vEnt
                             (vlax-curve-GetParamAtPoint vEnt PntOdd)))))
       (command "_line" (setq sPtO (polar PntOdd cAngO (/ dOd 2.0)))
            (setq ePtO (polar PntOdd (+ pi cAngO) (/ dOd 2.0))) "")
       (command "_line" sPtE sPtO "")
       (command "_line" ePtE ePtO "")
       (setq last_pt1 sPtO last_pt2 ePtO i (+ inc i)))))
     (if Cent (vla-put-Color vEnt acblue) (vla-delete vEnt)))
   (princ "\n<!> Points Specified Incorrectly <!>"))
 (mapcar 'setvar vLst oVars)
 (princ))

mdbdesign Experienced

mdbdesign

Posted
  • Author
Posted

Will try at home. Big thanks Lee

Lee Mac Grand Master

Lee Mac

Posted
Posted
  mdbdesign said:
Will try at home. Big thanks Lee

 

 

No probs, I had fun working on it :)

mdbdesign Experienced

mdbdesign

Posted
  • Author
Posted

Lee, Cadtutor will be temporary shutdown on weekend so you have lots of time. Don't rush, is weekend: have fun!

Lee Mac Grand Master

Lee Mac

Posted
Posted
  mdbdesign said:
Lee, Cadtutor will be temporary shutdown on weekend so you have lots of time. Don't rush, is weekend: have fun!

 

Cheers, will see what I can do for you :)

mdbdesign Experienced

mdbdesign

Posted
  • Author
Posted

Thanks Oleg, now I will got time to go on Cadtutor instead of loosing time for drawing. I am so happy now. Will buy bottle today and wait when you coming visit me.

You too Lee (drinking limit in Canada is 19 years of age)

Lee Mac Grand Master

Lee Mac

Posted
Posted
  mdbdesign said:
Thanks Oleg, now I will got time to go on Cadtutor instead of loosing time for drawing. I am so happy now. Will buy bottle today and wait when you coming visit me.

You too Lee (drinking limit in Canada is 19 years of age)

 

Many thanks - seems that Fixo hit the nail on the head :) :D

 

Have a good weekend :)

 

Lee

  • 2 weeks later...
rbeldua Apprentice

rbeldua

Posted
Posted

hi guys....am new here, just a thought... will it be possible to have a lisp like the elbow flex duct except it goes straight and makes elbow too, like the duct lisp and wpipe...it will be great if i could have one lisp like that...:shock:

Lee Mac Grand Master

Lee Mac

Posted
Posted

I made this a while back, not sure if it helps or not :P

 

(defun c:duct  (/ *error* oVars vLst p1 p2 vEnt i PntEve PntOdd cAngE sPtE ePtE cAngO sPtO ePtO
               last_pt1 last_pt2)
 (defun *error*  (msg)
   (if oVars
     (mapcar 'setvar vLst oVars))
   (princ (strcat "\nError: " (strcase msg)))
   (princ))
 (setq vLst  '("CMDECHO" "CLAYER" "FILLMODE" "OSMODE" "PLINEWID")
       oVars (mapcar 'getvar vLst))
 (setvar "CMDECHO" 0)
 (setvar "FILLMODE" 0)
 (if (not (tblsearch "LAYER" "DUCT"))
   (command "-layer" "M" "DUCT" "_C" "1" "DUCT" "")
   (setvar "CLAYER" "DUCT"))
 (vl-load-com)
 (if (and (setq p1 (getpoint "\nSpecify First Point: ")
                p2 (getpoint p1 "\nIndicate Direction of Duct: ")))
   (progn
     (setvar "PLINEWID" 6)
     (setvar "OSMODE" 0)
     (command "_pline" p1 (polar p1 (angle p1 p2) 2.0) "_arc")
     (while (> (getvar "CMDACTIVE") 0) (command pause))
     (setq vEnt (vlax-ename->vla-object (entlast))
           i    2.0)
     (while (and (setq PntEve (vlax-curve-GetPointatDist vEnt i)
                       PntOdd (vlax-curve-GetPointatDist vEnt (setq i (1+ i)))))
       (setq cAngE (+ (/ pi 2)
                      (angle '(0 0 0)
                             (vlax-curve-getFirstDeriv
                               vEnt
                               (vlax-curve-GetParamAtPoint vEnt PntEve)))))
       (command "_line"
                (setq sPtE (polar PntEve cAngE 4.0))
                (setq ePtE (polar PntEve (+ pi cAngE) 4.0))
                "")
       (if (and last_pt1 last_pt2)
         (progn (command "_line" last_pt1 sPtE "") (command "_line" last_pt2 ePtE "")))
       (setq cAngO (+ (/ pi 2)
                      (angle '(0 0 0)
                             (vlax-curve-getFirstDeriv
                               vEnt
                               (vlax-curve-GetParamAtPoint vEnt PntOdd)))))
       (command "_line"
                (setq sPtO (polar PntOdd cAngO 3.0))
                (setq ePtO (polar PntOdd (+ pi cAngO) 3.0))
                "")
       (command "_line" sPtE sPtO "")
       (command "_line" ePtE ePtO "")
       (setq last_pt1 sPtO
             last_pt2 ePtO)
       (setq i (1+ i)))
     (vla-put-ConstantWidth vEnt 0.0)
     (vla-put-Color vEnt acblue))
   (princ "\n<!> Points Specified Incorrectly <!>"))
 (mapcar 'setvar vLst oVars)
 (princ))

tzframpton Grand Master

tzframpton

Posted
Posted

Someone over at the swamp has an entire HVAC Lisp program suite, actually. I think CAB has like 3 or 4 different flex LISP.

Lee Mac Grand Master

Lee Mac

Posted
Posted

I think TimSpangler has also got a whole suite - posted somewhere on here. :thumbsup:

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...