Flex duct

[sam_safinia]

I found this lisp in here and is working fine but you have to draw a pline first then run routine to get flex duct shape.I am wondering if I can:

1) have a pline command within this lisp to draw needed pline then draw flex like shapes over it.Something like:

(defun c:Flex (/    SP     cl-ent    ribWidth  RibShort  RibLong   collar
               dist      steps     ribFlag   pt        curAng    curDer
               RibPtLst1 RibPtLst2 p1        p2        doc       space
               cflag     cl-len    ribRadius tmp       NewPline  NewPline2 
               pl1       pl2       cnt       errflag   InsulThick   FlexColor
               FlexLayer ss        FlexCLLayer   lyrent *error*
              )			  
			  
(command "PLINE" SP "W" "0.0"  "W" "0.0" "0.0" "ARC")
			  
  (defun *error* (msg) (vl-bt))
  (vl-load-com)
  (setq Doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
........

2) at the end of the lisp, it convert all items into a block name it as flx.01,.. 

Thanks

[Kent1Cooper · Accepted solution]

That has an option to set a Diameter value at the place where it's asking you to select the center-line object.  If you're drawing rather than selecting a Polyline, should the option to set a Diameter come before or after you draw it?  If it is also to offer the Enter-to-quit option, presumably it should be before drawing the Polyline, which would at the very least move the Polyline command later than in your "something-like" beginning.

The Polyline drawing part would be, if you want it forced to zero width and starting in arc mode, something like this:

(command "_.pline" pause "_width" 0 "" "_arc); leave you in Pline command

(while (> (getvar 'cmdactive) 0) (command pause)); allow user input until command is completed

Then it would go on to work out the flex-duct business over the resulting Polyline.

But the first pause above could be replaced by a variable, if [for example] the starting point is something set by picking a point where the options are offered to set the Diameter or quit instead.  So the sequence of events you want is important to know.

[sam_safinia]

Thanks Kent. It works fine. Only one quotation mark was missed at the end of pline command

...."_arc")

[Kent1Cooper]

---

@s_plant wrote:

Thanks Kent. It works fine. Only one quotation mark was missed at the end of pline command

...."_arc")

---

Ah, yes -- The scourge of the Post-without-testing approach....  Sorry about that, but I'm glad you figured it out.

[sam_safinia]

Hi again!!

I tried many ways and methods but no success 😞

How can I add all drawn entitiy ofthis lisp into a block?(block name can be the same or have a counter)

Cheers

Spoiler

(defun c:MainFelx (/ cl-ent ribWidth RibShort RibLong collar
dist steps ribFlag pt curAng curDer
RibPtLst1 RibPtLst2 p1 p2 doc space
cflag cl-len ribRadius tmp NewPline NewPline2
pl1 pl2 cnt errflag InsulThick FlexColor
FlexLayer ss FlexCLLayer lyrent *error*
)
(command "_.-LAYER" "_M" "Flex_Centreline" "_C" "4" "Flex_Centreline" "_LW" 0.15 "Flex_Centreline" "")
(command "_.pline" pause "_width" 0 "" "_arc")
(while (> (getvar 'cmdactive) 0) (command pause)); allow user input until command is completed
(defun *error* (msg) (vl-bt))
(vl-load-com)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark doc)
(vla-startundomark doc)

;; \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/


(command "_.-LAYER" "_M" "FLEX DUCT" "_C" "252" "FLEX DUCT" "_LW" 0.35 "FLEX DUCT" "")
(setq FlexLayer "MECHANICAL FLEX DUCT") ; put your Duct layer here
;(setq FlexColor 252) ; put your color over ride here or Bylayer
(setq FlexCLLayer "xx");"0") ; put your Duct Center Line layer here, "" or nil = no change
(setq InsulThick 0.15) ; to be added to duct diameter, use 2 for 1" insulation
(setq collar 0) ; collar length at each end
(setq DelCL nil) ; delete the centerline t=Yes nil=No
(setq GroupFlex nil) ; make flex duct a Group t=Yes nil=No

;; \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/


;; -------- Local Functions ---------

;; Expects pts to be a list of 2D or 3D points
(defun makePline (spc pts)
(if (= (length (car pts)) 2) ; 2d point list
(setq pts (apply 'append pts))
(setq
pts (apply 'append (mapcar '(lambda (x) (list (car x) (cadr x))) pts))
)
)
(setq
pts (vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 (1- (length pts))))
pts
)
)
)
(vla-addlightweightpolyline spc pts)
)
(defun _CreateAnonymousGroup ( ) ; courtesy of Michael Puckett
(vla-add
(vla-get-groups
(vla-get-activedocument (vlax-get-acad-object))) "*")
)

;; Get the Duct Diameter, global variable
(or duct:dia (setq duct:dia 150.0)) ; default value


;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;; S T A R T H E R E
;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(while ; Main Loop
(progn
(prompt (strcat "\nDuct diameter is set to "
(vl-princ-to-string duct:dia)
)
)
(setvar "errno" 0) ; must pre set the errno to 0
(initget "Diameter")
(setq cl-ent
(entsel (strcat "\nSelect center line of flex duct.[Diameter]<"
(vl-princ-to-string duct:dia)
"> Enter to quit."))
)

(cond
((null (setq lyrent (tblobjname "layer" Flexlayer)))
(prompt (strcat "\nDuct Layer " Flexlayer " does not exist."))
)
((= 4 (logand 4 (cdr (assoc 70 (entget lyrent)))))
(prompt (strcat "\nDuct Layer " Flexlayer " is LOCKED."))
)
((and FlexCLlayer (/= FlexCLlayer "")
(null (setq lyrent (tblobjname "layer" FlexCLlayer)))
(princ (strcat "\n*** Center Line Layer " FlexCLlayer " does not exist. ***"))
(setq FlexCLlayer nil))
)
((= (getvar "errno") 52) ; exit if user pressed ENTER
nil ; exit loop
)
((= cl-ent "Diameter")
(initget (+ 2 4))
(setq
tmp (getdist
(strcat "\nSpecify duct diameter <" (rtos duct:dia) ">: ")
)
)
(and tmp (setq duct:dia tmp))
t ; stay in loop
)

((vl-consp cl-ent)
;; check entity before making the duct
(if (not (vl-catch-all-error-p
(setq tmp (vl-catch-all-apply
'vlax-curve-getpointatparam
(list (car cl-ent) 0.0)
)
)
)
)
(progn ; OK to make duct
(setq cl-ent (car cl-ent) ; Center Line
ribWidth (* duct:dia 0.167)
RibShort (+ duct:dia InsulThick) ; add insulation
RibLong (+ RibShort (* ribWidth 2))
)

;; centerline length
(setq cl-len (vlax-curve-getdistatparam
cl-ent
(vlax-curve-getendparam cl-ent)
)
steps (/ cl-len ribWidth)
)
(if (= (logand (fix steps) 1) 1) ; T = odd
(setq steps (fix steps))
(setq steps (1+ (fix steps)))
)
(setq ribWidth (/ (- cl-len 0.25) (1- steps))
dist 0.125 ; distance along center line
)


(setq ribFlag 0
cflag t
cnt 0
pl1 nil
pl3 nil
errflag nil
)

;; ---------- Create Rib End Points -----------
(repeat steps
(setq pt (vlax-curve-getpointatdist cl-ent dist))
; (/ 1 0) debug - force error
(setq
curDer (trans
(vlax-curve-getfirstderiv
cl-ent
(vlax-curve-getparamatpoint cl-ent pt)
)
0
1
)
)
;; Get angle 90 deg to curve
(setq curAng (+ (/ pi 2) (angle '(0 0) curDer)))
(setq ribRadius (if (zerop ribFlag)
(/ RibShort 2)
(/ RibLong 2)
)
)
(setq pt (trans pt 0 1)) ; WCS > UCS
(setq p1 (polar pt curAng ribRadius))
(setq p2 (polar pt (+ pi curAng) ribRadius))
(if cflag ; create start collar points
(setq RibPtLst1 (list (polar p1 (angle curDer '(0 0)) collar))
RibPtLst2 (list (polar p2 (angle curDer '(0 0)) collar))
cflag nil
)
)

;; this collection method creates a woven pline
(cond
((null pl1) ; first time through
(setq RibPtLst1 (cons p1 RibPtLst1)
RibPtLst2 (cons p2 RibPtLst2)
)
)
((= (logand (setq cnt (1+ cnt)) 1) 1) ; T = odd cnt
(setq RibPtLst1 (cons pl2 RibPtLst1)
RibPtLst1 (cons p2 RibPtLst1)
RibPtLst2 (cons pl1 RibPtLst2)
RibPtLst2 (cons p1 RibPtLst2)
)
)
((setq RibPtLst1 (cons pl1 RibPtLst1)
RibPtLst1 (cons p1 RibPtLst1)
RibPtLst2 (cons pl2 RibPtLst2)
RibPtLst2 (cons p2 RibPtLst2)
)
)
)
(if (and pl3 (inters p1 p2 pl3 pl4 t))
(setq errflag t)
)
(setq ribFlag (- 1 ribFlag) ; toggle flag
dist (+ ribWidth dist)
pl3 pl1
pl4 pl2
pl1 p1
pl2 p2
)
)
;; create end collar points
(setq RibPtLst1 (cons p2 RibPtLst1)
RibPtLst1 (cons (polar p2 (angle '(0 0) curDer) collar) RibPtLst1)
RibPtLst2 (cons p1 RibPtLst2)
RibPtLst2 (cons (polar p1 (angle '(0 0) curDer) collar) RibPtLst2)
)

;; -------- point list to WCS ------------
(setq RibPtLst1 (mapcar '(lambda (x) (trans x 1 0)) RibPtLst1))
(setq RibPtLst2 (mapcar '(lambda (x) (trans x 1 0)) RibPtLst2))

;; -------- create jacket plines ------------
(or space
(setq space
(if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc) ; active VP
(vla-get-paperspace doc)
)
(vla-get-modelspace doc)
)
)
)

(cond
((and errflag
(progn
(initget "Yes No")
(= "No"
(cond
((getkword "\nTurns too tight, Proceed? [Yes/No]<Yes>:"))
("Yes")))
)
)
t ; skip the create & stay in loop
)
((setq newpline (makePline space RibPtLst1))
(vla-put-layer newpline Flexlayer)
(if FlexColor
(vla-put-color newpline FlexColor)
)
;;(vla-put-elevation newpline z)

(setq newpline2 (makePline space RibPtLst2))
(vla-put-layer newpline2 Flexlayer)
(if FlexColor
(vla-put-color newpline2 FlexColor)
)
;;(vla-put-elevation newpline z)

(if DelCL
(entdel cl-ent) ; remove the centerline object
(if (and FlexCLlayer (/= FlexCLlayer "")
(setq lyrent (tblobjname "layer" (cdr(assoc 8 (entget cl-ent)))))
(or (/= 4 (logand 4 (cdr (assoc 70 (entget lyrent)))))
(prompt "\n*** Center Line layer is LOCKED ***"))
)
(vla-put-layer (vlax-ename->vla-object cl-ent) FlexCLlayer)
)
)
;| COMMAND method removed due to errors in ACAD2008
(if GroupFlex
(progn
(setq ss (ssadd))
(ssadd (vlax-vla-object->ename newpline) ss)
(ssadd (vlax-vla-object->ename newpline2) ss)
(or DelCl (ssadd cl-ent ss))
(if (vl-cmdf "_.-group" "_create" "*" "" ss "")
(princ "\nGrouping Done")
(princ "\nError Grouping")
)
)
)
|;
(if GroupFlex
(progn ; using Michael Puckett's method
(setq GroupObjects (list newpline newpline2))
(or DelCl (setq GroupObjects
(cons (vlax-ename->vla-object cl-ent) GroupObjects)))
(setq myGroup (_CreateAnonymousGroup))
(vlax-invoke myGroup 'AppendItems GroupObjects)
)
)

)
) ; cond
) ; progn
(princ "\nError - Can not use that object, Try again.")
) ; endif
t
)
(t (princ "\nMissed Try again."))
) ; cond stmt
) ; progn
) ; while
(vla-endundomark doc)
(and space (vlax-release-object space))
(vlax-release-object doc)
(princ)
)
;;----------- E N D O F L I S P ----------------------------

[Kent1Cooper]

---

@s_plant wrote:

.... 

How can I add all drawn entitiy ofthis lisp into a block?....

---

The typical way of doing that would be to save the last entity in the drawing into a variable before the routine draws anything, and then when it's done, put everything newer than that saved entity into a selection set and use that in a Block command.  Something like:

(setq

  lastent (entlast); whatever was last drawn before routine

  newstuff (ssadd); initially-empty selection set

); setq

.... routine does its thing, after which, ....

(while (setq lastent (entnext lastent)); step through everything the routine added

  (ssadd lastent newstuff); and add it to the selection set

); while

Then use that newstuff selection set as object selection in a Block command.

[parab.sushant]

thanks for such an awesome lsp Mr. Kent,,,,,,,,but i hav one issue with the new lsp from the oriinator of this post,,,,,,,how to add the code shown above iin this post so i can enter diameter manually ??

thanks a lot,,,god bless u 🙂

[Kent1Cooper]

---

@parab.sushant wrote:

thanks for such an awesome lsp Mr. Kent,,,,,,,,but i hav one issue with the new lsp from the oriinator of this post,,,,,,,how to add the code shown above iin this post so i can enter diameter manually ??

thanks a lot,,,god bless u 🙂

---

It's not my "awesome" routine -- I only offered some adjustments.  [The OP apparently didn't credit who wrote it.]

In any case, it already has a place where you can enter your desired Diameter manually, by choosing that option:

Is that not what you're asking about?  I'm not sure what you mean by "the code shown above iin this post," so maybe I'm misunderstanding your question.

[parab.sushant]

thanks,,,,,got it 🙂

[Anonymous]

how do i put other color? i want to use grey color or known as color 8 in ACI on centerline, but i cant find the name for that color. i had try 008, color8, 8, RGB:128,128,128. none of them work. thank you.

[Kent1Cooper]

---

@Anonymous wrote:

how do i put other color? i want to use grey color or known as color 8 in ACI on centerline, but i cant find the name for that color. i had try 008, color8, 8, RGB:128,128,128. none of them work. thank you.

---

How  are you trying to put that color on the centerline?  In some approaches, just plain 8 should work, but in others, you need to put it in double-quotes -- "8" -- because a string  is needed, to account for the possibility of color names  and "ByLayer" and "ByBlock."

[Anonymous]

Nice.. Thank for your info.. Work it well..