double line flex lisp

[barraganarq]

Tim, attached is the file I am trying to use

 

Thanks, Cesar

flex.LSP

[rodpete]

Has anybody hard of qduct program.

[MPEConsult]

Thanks Tim!

[rodpete]

tim,

can you look at this

2duct.lsp

[amr yousri]

Please TIM reffer to flex.lsp v1.2 how can i controlling in the distance between the lines ?

[gd54cad]

This is a stunning lisp routine, I have been looking for one like this for sometime.

Thanks so much

[Chelin]

Hi i just downloaded flex 17 cab.lsp, wich command u use to draw it?

Thanks

[CAB]

Type FLEX at the command line.

 

See attached latest version.

Flex 21 CAB.LSP

[Chelin]

Thanks CAB...

[henryd11]

Here it is! QDUCT.zip

[Chris H]

Hello. Old thread, sorry for reviving it! I like CAB's LISP routine and I have had success modifying it to my liking. However, is there a way to automatically put the centerline (the line that you make first to define your flex path) on defpoints while the actual flex is on the layer of your choosing?

[CAB]

Look for this in the code:

  ;;  Default settings, Change these if you want
 
 (or FlexLayer  (setq FlexLayer   "0" )) ; put your Duct layer here
 (or FlexColor  (setq FlexColor   nil )) ; put your color over ride here or nil
 (or FlexCLLayer(setq FlexCLLayer "" ))  ; put your Duct Center Line layer here, "" or nil = no change
 (or InsulThick (setq InsulThick  0   )) ; to be added to duct diameter, use 2 for 1" insulation
 (or collar     (setq collar      4.0 )) ; collar length at each end, can be 0
 (setq cflag   nil)                        ; Add collar flag
 (or DelCL      (setq DelCL       nil )) ; delete the centerline t=Yes nil=No
 (or GroupFlex  (setq GroupFlex   nil )) ; make flex duct a Group t=Yes nil=No
 (if DuctDiam ; override the first time only
   (or duct:dia (setq duct:dia DuctDiam)) ; Duct Diameter, global variable
   (or duct:dia (setq duct:dia     16.0)) ; Duct Diameter, global variable
 )

 

Change Flexlayer for the duct & change FlexCLLayer to DefPoints

 

Bug fix in ver 2.2

Flex 22 CAB.LSP

[Chris H]

Look for this in the code:

 

Change Flexlayer for the duct & change FlexCLLayer to DefPoints

 

Bug fix in ver 2.2

 

Thanks for the quick response! I will play with this tomorrow.

 

Something else occurred to me, is there a way for the rib distance to scale with your drawing scale? I wanted to extend the ribs a bit for 1/8" scale and now they are too wide for 1/4". These may be questions that are answered somewhere, is there a more recent reference for this lisp?

[ramale]

(defun c:DUCT(/ actDoc ang1 ang2 ang3 ptLst enDist

fPt lEnt lObj lPln oldVars oldWd

plEnd plStart1 plStart2 prDir

segLst Start stDist stLst tAng

vlaPln cFlg *error*)

 

(vl-load-com)

 

(defun GetPlineVer(plObj)

(mapcar 'cdr

(vl-remove-if-not

'(lambda(x)(=(car x)10))

(entget plObj)))

); end of GetPLineVer

 

(defun asmi-PlineSegmentDataList(plObj / cLst outLst)

(setq cLst

(vl-remove-if-not

'(lambda(x)(member(car x) '(10 40 41 42)))

(entget plObj))

outLst '()

); end setq

(while cLst

(if(assoc 40 cLst)

(progn

(setq outLst

(append outLst

(list

(list

(cdr(assoc 10 cLst))

(cdr(assoc 40 cLst))

(cdr(assoc 41 cLst))

(cdr(assoc 42 cLst))

); end list

); end list

); end if

); end setq

(repeat 4

(setq cLst(cdr cLst))

); end repeat

); end progn

(setq outLst

(append outLst

(list

(list

(cdr(assoc 10 cLst))

); end list

); end list

); end append

cLst nil

); end setq

); end if

); end while

outLst

); end of asmi-GetPlineSegmentData

 

 

(defun asmi-LayersUnlock(/ restLst)

(setq restLst '())

(vlax-for lay

(vla-get-Layers

(vla-get-ActiveDocument

(vlax-get-acad-object)))

(setq restLst

(append restLst

(list

(list

lay

(vla-get-Lock lay)

(vla-get-Freeze lay)

); end list

); end list

); end append

); end setq

(vla-put-Lock lay :vlax-false)

(if

(vl-catch-all-error-p

(vl-catch-all-apply

'vla-put-Freeze(list lay :vlax-false)))

t)

); end vlax-for

restLst

); end of asmi-LayersUnlock

 

(defun asmi-LayersStateRestore(StateList)

(foreach lay StateList

(vla-put-Lock(car lay)(cadr lay))

(if

(vl-catch-all-error-p

(vl-catch-all-apply

'vla-put-Freeze(list(car lay)(nth 2 lay))))

t)

); end foreach

(princ)

); end of asmi-LayersStateRestore

 

(defun PipeMLineStyle(/ dxfLst mlDict)

(setq dxfLst

(list'(0 . "MLINESTYLE")'(102 . "{ACAD_REACTORS")'(102 . "}")

'(100 . "AcDbMlineStyle") '(2 . "DUCT_PIPE")

'(70 . 274)'(3 . "")'(62 . 256)'(51 . 1.5708)'(52 . 1.5708)

'(71 . 2)'(49 . 0.5)'(62 . 256)'(6 . "BYBLOCK")

'(49 . -0.5)'(62 . 256)'(6 . "BYBLOCK"))); end setq

(if

(null

(member

(assoc 2 dxfLst)

(dictsearch

(namedobjdict)

"ACAD_MLINESTYLE")))

(progn

(setq mlDict

(cdr

(assoc -1

(dictsearch

(namedobjdict)

"ACAD_MLINESTYLE"))))

(dictadd mlDict

(cdr(assoc 2 dxfLst))(entmakex dxfLst))

); end progn

); end if

); end of PipeMLineStyle

 

(defun SideCalculate(Wdth Ang / Rad)

(setq Ang(- pi Ang))

(setq Rad(* (if (= dpipeelb "Mitered") 0.5 dpiper/w) Wdth))

(+ (if (= dpipeelb "Mitered") dpipetan 0)

(*

(/

(sqrt(-(* 2(expt Rad 2))(* 2(expt Rad 2)(cos Ang))))

(sin(- pi Ang)))(sin(/(- pi(- pi Ang))2.0)

)

)

)

); end of SideCalculate

 

 

(defun BodyFunction()

(if

(not

(equal lObj(entlast)))

(progn

(setq lEnt(entlast)

stLst(asmi-LayersUnlock)

segLst(asmi-PlineSegmentDataList lEnt)

vlaPln(vlax-ename->vla-object lEnt)

); end setq

(setvar "OSMODE" 0)

(setvar "CMDECHO" 0)

(while (/= 1(length segLst))

(setq stDist

(vlax-curve-getDistAtPoint vlaPln

(caar segLst))

enDist

(vlax-curve-getDistAtPoint vlaPln

(caadr segLst))

); end setq

(if(

(progn

(setq ang1

(+(/ pi 2)(angle(caar segLst)(caadr segLst)))

ang2

(+(/ pi 2)(angle(caadr segLst)(car(nth 2 segLst))))

); end setq

); end progn

); end if

(if

(or

(not Start)

prDir

);end or

(setq plStart1

(vlax-curve-getPointAtDist vlaPln

stDist)

Start T); end setq

(setq plStart1

(vlax-curve-getPointAtDist vlaPln

(+ stDist(SideCalculate(cadar segLst)ang3)))); end setq

); end if

(if(and ang1 ang2)

(progn

(if(> ang1 ang2)

(setq ang3(- ang1 ang2))

(setq ang3(- ang2 ang1))

); end if

(setq ang3(- pi ang3)

tAng ang3)

(if(minusp ang3)(setq ang3(- ang3)))

); end progn

); end if

 

(if

(or

(equal ang1 ang2 0.000001)

(= 2(length segLst))

); end or

(setq plEnd

(vlax-curve-getPointAtDist vlaPln

enDist)

prDir T); end setq

(setq plEnd

(vlax-curve-getPointAtDist vlaPln

(- enDist(SideCalculate(cadar segLst)ang3)))

prDir nil); end setq

); end if

(if

(

(setq plStart2

(vlax-curve-getPointAtDist vlaPln

(+ enDist(SideCalculate(cadar segLst)ang3)))); end setq

); end if

(if(

(if

(=(cadar segLst)(nth 2(car segLst)))

(setq ptLst

(mapcar

'(lambda(x)(trans x 0 1)); end lambda

(append

(if (not (/= "Segmented" dpipeelb "Mitered"))

(progn

(setq ang4 (apply '(lambda(x)(atan x (sqrt (abs (1- (* x x))))))

(list (sin (- ang1 (/ pi 2.0) (angle plEnd plStart2)))))

)

(setq SegNum (cond ((or (= dpipeelb "Mitered") (

(* (/ 35 360.0) pi))) 2) ((

((

)

(setq tan4 (+ (if (= dpipeelb "Mitered") dpipetan 0.0) (*

(if (= dpipeelb "Mitered") 0.5 dpiper/w) (cadar segLst)

(abs (apply '(lambda(x) (/ (sin x) (cos x))) (list (/ ang4

0.5 (1- SegNum) 2.0))))))

)

(setq mllst (list plEnd (polar plEnd (- ang1 (/ pi 2.0)) tan4)))

(setq SegCnt 0)

(while (

(setq mllst (append mllst (list (polar (last mllst)

(+ (angle (cadr (reverse mllst)) (last mllst))

(/ ang4 -0.5 (1- SegNum))) (* tan4 2.0)))

)

SegCnt (1+ SegCnt)

)

)

(setq mllst (append mllst (list PlStart2)))

(setq SegCnt (- (length mllst) 2))

(setq pllst nil)

(while (> SegCnt 0)

(setq pllst (append pllst (list (polar (nth SegCnt mllst)

(+ (angle (nth (1- SegCnt) mllst) (nth SegCnt mllst))

(/ pi 2.0) (/ ang4 0.5 (1- SegNum) -2.0))

(/(cadar segLst)2(cos (/ ang4 0.5 (1- SegNum) 2.0)))))

)

SegCnt (1- SegCnt)

)

)

pllst

)

)

(list(polar plEnd ang1 (/(cadar segLst)2)))

(list(polar plEnd (+ pi ang1)(/(cadar segLst)2)))

(if (not (/= "Segmented" dpipeelb "Mitered"))

(progn

(setq SegCnt 1)

(setq pllst nil)

(while (

(setq pllst (append pllst (list (polar (nth SegCnt mllst)

(+ (angle (nth (1- SegCnt) mllst) (nth SegCnt mllst))

(* pi 1.5) (/ ang4 0.5 (1- SegNum) -2.0))

(/(cadar segLst)2(cos (/ ang4 0.5 (1- SegNum) 2.0)))))

)

SegCnt (1+ SegCnt)

)

)

(setq mllst (mapcar '(lambda(x)(trans x 0 1)) mllst))

pllst

)

)

(list(polar plStart2 (+ pi ang2)(/(cadar segLst)2)))

(list(polar plStart2 ang2 (/(cadar segLst)2)))

); end append

); end mapcar

); end setq

(setq ptLst

(mapcar

'(lambda(x)(trans x 0 1)); end lambda

(list (polar plStart1 ang1 (/(cadar segLst)2))

(polar plStart1 (+ pi ang1)(/(cadar segLst)2))

(polar(caadr segLst)(+ pi ang2)(/(nth 2(car segLst))2))

(polar(caadr segLst)ang2(/(nth 2(car segLst))2))

); end list

); end mapcar

); end setq

); end if

); end if

(setq plStart1(trans plStart1 0 1)

plEnd(trans plEnd 0 1)

); end setq

(if plStart2

(setq plStart2(trans plStart1 0 1))

); end if

(if (

(if (or (/=(cadar segLst)(nth 2(car segLst)))

(and (/= "Segmented" dpipeelb) (not(equal ang1 ang2 0.000001))

); end and

); end or

(progn

(setvar "PLINEWID" 0.0)

(command "_.pline")

(mapcar 'command ptLst)(command "_c")

(setvar "PLINEWID" dpipepWd)

); end progn

(if (and (= "Segmented" dpipeelb) (not(equal ang1 ang2 0.000001)))

(progn

(command "_.mline" "_st" "DUCT_PIPE" "_S" (cadar segLst) "_J" "_Z")

(mapcar 'command mlLst)

(command "")

; (setvar "PLINEWID" 0.0)

; (command "_.pline")

; (mapcar 'command ptLst)(command "_c")

; (setq SegCnt 0)

; (while (

; (command "_.line" (nth SegCnt ptlst)

; (nth (- (length ptlst) 3 SegCnt) ptlst)

; ""

; )

; (setq SegCnt (1+ SegCnt))

; )

; (setvar "PLINEWID" dpipepWd)

); end progn

); end if

); end if

); end if

(if

(and (= dpipeelb "Radius")

(not(equal ang1 ang2 0.000001))

(

); end and

(progn

(setq lPln

(vlax-ename->vla-object(entlast))

tAng (abs (- ang2 ang1))

); end setq

(if (> tAng pi)

(if(

(setq ang1(+ ang1 pi)

ang2(- ang2 pi)); end setq

(setq ang1(- ang1 pi)

ang2(+ ang2 pi)); end setq

); end if

); end if

(setq Bulge(/(sin(/(rem(- ang2 ang1)pi)4.0))(cos(/(rem(- ang2 ang1)pi)4.0))))

(vla-SetBulge lPln 1 Bulge)

(vla-SetBulge lPln 3 (- Bulge))

); end progn

); end if

(if

(=(cadar segLst)(nth 2(car segLst)))

(command "_.mline" "_st" "DUCT_PIPE"

"_S" (cadar segLst) "_J" "_Z"

plStart1 plEnd "")

; (progn

; (setq ptLst

; (list (polar plStart1 (+ (angle plStart1 plEnd) (/ pi 2.0)) (/(cadar segLst)2))

; (polar plStart1 (- (angle plStart1 plEnd) (/ pi 2.0)) (/(cadar segLst)2))

; (polar plEnd (- (angle plStart1 plEnd) (/ pi 2.0)) (/(nth 2(car segLst))2))

; (polar plEnd (+ (angle plStart1 plEnd) (/ pi 2.0)) (/(nth 2(car segLst))2))

; )

; )

; (setvar "PLINEWID" 0.0)

; (command "_.pline")

; (mapcar 'command ptLst)(command "_c")

; (setvar "PLINEWID" dpipepWd)

; ); end progn

); end if

 

(setq segLst(cdr segLst)); end setq

); end while

(command "_.erase" lEnt "")

(asmi-LayersStateRestore stLst)

); end progn

); end if

); end of Body Function

 

(defun *error*(msg)

(if actDoc

(vla-EndUndoMark actDoc)

); end if

(setvar "CMDECHO" 0)

(command "_.undo" "1")

(if oldVars

(mapcar 'setvar

'("FILLMODE" "PLINEWID" "CMDECHO" "OSMODE")

oldVars); end mapcar

); end if

(if (not (member msg '("console break" "Function cancelled" "quit / exit abort" "")))

(princ (strcat "\nError: " msg))

(princ)

)

); end of *error*

 

(PipeMLineStyle)

 

(if(not dpipepWd)(setq dpipepWd 1.0))

(setq oldWd dpipepWd

oldVars(mapcar 'getvar '("FILLMODE" "PLINEWID" "CMDECHO" "OSMODE"))

); end setq

(if(entlast)(setq lObj(entlast)))

(vla-StartUndoMark

(setq actDoc

(vla-get-ActiveDocument

(vlax-get-acad-object))))

(setq dlastelb dpipeelb)

(initget "Mitered Radius Segmented")

(setq dpipeelb (getkword (strcat "\nSpecify elbow type "

(if (= dlastelb "Mitered") "/" "Mitered/")

(if (= dlastelb "Segmented") "/" "Segmented/")

(if (/= "Mitered" dlastelb "Segmented")

(strcat ": ")

"Radius: "))

)

)

(if (or (= dpipeelb "Mitered") (and (not dpipeelb) (= dlastelb "Mitered")))

(progn

(initget 6)

(setq dlasttan dpipetan

dpipetan (getdist (strcat "\nNew elbow throat length

(rtos (if (/= (type dlasttan) 'REAL)

(setq dlasttan 6.0) dlasttan)) ">: ")

)

)

(if (not dpipetan) (setq dpipetan dlasttan))

(if (not dpipeelb) (setq dpipeelb dlastelb))

(setq dlasttan nil)

)

(progn

(initget 6)

(setq dlastr/w dpiper/w

dpiper/w (getdist (strcat "\nNew centerline r/w factor

(rtos (if (/= (type dlastr/w) 'REAL)

(setq dlastr/w 1.5) dlastr/w)) ">: ")

)

)

(if (not dpiper/w) (setq dpiper/w dlastr/w))

(if (not dpipeelb) (setq dpipeelb dlastelb))

(setq dlastr/w nil dpiper/w (max dpiper/w 0.5))

)

)

(initget 128)

(while(not cFlg)

(setq fPt

(getpoint

(strcat

"\nSpecify start point or width

(rtos dpipepWd) ">: " ))); end setq

(cond

((= 'LIST(type fPt))

(setq cFlg T)

); end condition #1

((= 'REAL(type(distof fPt)))

(setq dpipepWd(distof fPt)); end setq

); end condition #2

(T

(princ "\nInvalid option keyword! ")

); end condition #3

); end cond

); end while

(mapcar 'setvar

'("FILLMODE" "PLINEWID" "CMDECHO")

(list 0 dpipepWd 0)); end mapcar

(command "_.pline" fPt)

(setvar "CMDECHO" 1)

(while(= 1(getvar "CMDACTIVE"))

(command pause)

); end while

(setq dpipepwd (getvar "PLINEWID"))

(BodyFunction)

(vla-EndUndoMark actDoc)

(mapcar 'setvar

'("FILLMODE" "PLINEWID" "CMDECHO" "OSMODE")

oldVars); end apply

(princ)

); end of c:DUCT

[AIberto]

 

Please read the Code Posting Guidelines and edit your post to include the Code in Code Tags.

[ramale]

Dear AIberto,

 

Please check the attached file of Autolisp.

 

pl;ease better checking, click following link:

 

http://www.cadtutor.net/forum/showth...am-for-AutoCAD

or

http://www.cadtutor.net/forum/showthread.php?30545-*FREE*-HVAC-or-Piping-program-for-AutoCAD

ductN.lsp

[AIberto]

Dear AIberto,

 

Please check the attached file of Autolisp.

 

pl;ease better checking, click following link:

 

http://www.cadtutor.net/forum/showth...am-for-AutoCAD

or

http://www.cadtutor.net/forum/showthread.php?30545-*FREE*-HVAC-or-Piping-program-for-AutoCAD

 

Thanks ramale

I don't need this routine .

if you want post the code , you can reply---> Go Advanced .

See here:

http://www.cadtutor.net/forum/showthread.php?9184-Code-posting-guidelines

[mikejonas]

thank you so much sir! cheers!