double line flex lisp

January 27, 2009

Tim, attached is the file I am trying to use

Thanks, Cesar

flex.LSP

March 2, 2009

Has anybody hard of qduct program.

March 10, 2009

Thanks Tim!

March 10, 2009

tim,

can you look at this

2duct.lsp

June 2, 2010

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

August 26, 2010

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

Thanks so much

August 15, 2011

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

Thanks

August 16, 2011

Type FLEX at the command line.

See attached latest version.

Flex 21 CAB.LSP

August 16, 2011

Thanks CAB...

February 8, 2012

Here it is! QDUCT.zip

March 11, 2014

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?

March 12, 2014

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

March 12, 2014

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?

December 4, 2014

(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

(cdr(assoc 10 cLst))

(cdr(assoc 40 cLst))

(cdr(assoc 41 cLst))

(cdr(assoc 42 cLst))

); end list

); end if

); end setq

(repeat 4

(setq cLst(cdr cLst))

); end repeat

); end progn

(setq outLst

(append outLst

(list

(cdr(assoc 10 cLst))

); 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

lay

(vla-get-Lock lay)

(vla-get-Freeze lay)

); 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

(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

(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

(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

December 4, 2014

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

December 4, 2014

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

December 4, 2014

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

September 18, 2015

thank you so much sir! cheers!

Sign In

double line flex lisp

Recommended Posts

barraganarq

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

rodpete

MPEConsult

rodpete

amr yousri

gd54cad

Chelin

CAB

Chelin

henryd11

Chris H

CAB

Chris H

ramale

AIberto

ramale

AIberto

mikejonas

Join the conversation

Tutorials

Forums

Activity