TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: CAB on October 05, 2007, 06:21:32 PM
-
Bored today so I created this routine. I still have a few issues with tight curves and abrupt changes in direction.
Perhaps some will try it out & report any other anomalies. Or any wish list items.
Thanks.
New Version 2.0 - Added Locked layer trap & CL change option .
;;;=======================[ FlexDuct.lsp ]==============================
;;; Author: Copyright© 2010 Charles Alan Butler (CAB)
;;; Contact or Updates @ www.TheSwamp.org
;;; Version: 2.0 Mar 25,2010
;;; Purpose: Create Flex Duct from a centerline that the user picks
;;; Centerline may be anything vla-curve will handle
;;; Sub_Routines:
;;; makePline which creates a LW Polyline
;;; Restrictions: UCS is supported
;;; Duct Layer is hard coded, see var Flexlayer
;;; Debug only error handler at this time
;;; Known Issues:
;;; Tight curves cause pline jacket distortion
;;; Added warning when this is about to occur
;;; Returns: none
;;;=====================================================================
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED ;
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR ;
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED. ;
;;; ;
;;; You are hereby granted permission to use, copy and modify this ;
;;; software without charge, provided you do so exclusively for ;
;;; your own use or for use by others in your organization in the ;
;;; performance of their normal duties, and provided further that ;
;;; the above copyright notice appears in all copies and both that ;
;;; copyright notice and the limited warranty and restricted rights ;
;;; notice below appear in all supporting documentation. ;
;;;=====================================================================
(defun c:Flex (/ 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*
)
(defun *error* (msg) (vl-bt))
(vl-load-com)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark doc)
(vla-startundomark doc)
;; \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
;; Change these if you want
(setq FlexLayer "0") ; put your Duct layer here
(setq FlexColor acred) ; 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) ; to be added to duct diameter, use 2 for 1" insulation
(setq collar 4.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)
)
;; -------------------------------------
;; Does not work in ACAD 2000
(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 16.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)
;;----------- E N D O F L I S P ----------------------------
(princ)
)
(prompt "\nFlex Duct loaded, Enter FLEX to run.")
(princ)
<edit: updated code>
-
That's some nice work, new toys are always fun, thanks CAB!
-
Thank you sir.
I revised the code fixing the jacket cross over problem, but the tight turns are still messing with me.
-
If there is no radius (sharp corner) then just make the radius at the center the same as the duct width, or make the small side radius the same. Looks pretty, but I haven't tested it yet. Will soon though.
-
How about making each duct an anonymous block?
-
Good idea Tim.
Off to prep dinner. :angel:
-
Changed the code.
New Version 1.1 - This version creates only 2 plines and no lines.
This is easier to erase.
-
Another awesome routine.
Thanks Cab.
-
Glad you all like it.
I am considering Tim's suggestion for blocks and am testing some code gile helped me with to deal with OCS when there are not the same as the current UCS.
Currently the routine will deal with current UCS in most cases.
Stay tuned for updates.
-
Wow, i will have to check this out when i get back into the office! Nice work CAB.
-
John, I forgot you were into HVAC. Let me know if you have any suggestions.
-
Alan;
I tried your routine.... Te sacaste un 10! (A+) - those HVAC users will love it.... :)
-
John, I forgot you were into HVAC. Let me know if you have any suggestions.
You got it. I will put the thunkin' cap on when i try it.
-
Alan;
I tried your routine.... Te sacaste un 10! (A+) - those HVAC users will love it.... :)
After further review;
(I have been playing with it all morning and not getting much work done.)
From archie's point of view, I like it becuase it graphically looks like a duct for when I need to show a piece of duct for coordination purposes. It stands out more than just two lines in a detail. And it handles all the radii without any input from me.
The bonus is its simplicity in the way it is used.
Score = 10
Bonus points = 5
:-)
-
Nice CAB :-)
-
Thank you Sir's. :-)
-
Thank you Sir's. :-)
Great routine. I like that it can do arcs and splines.
Gary
-
Updated code to display the duct diameter in the prompt and added a warning & option to skip if the duct will overlap itself. This occurs when the turns are too tight.
-
Alan
You may want to check out this routine from Robert Bell
;|
Flex.lsp
Version history
3.2 2003/03/04 Localized variable NextPointFactor. Added variable for default curve type
and layer color. Curve type was localized for the PEdit command.
3.1 2002/06/28 Anniversary (wedding) release. Update usage permissions.
3.0 2000/05/18 General use release.
2.1 1994/03/31 Added code for correct Release 12 operation.
2.0 1992/06/28 Major revision to support defaults & splined polylines.
1.0 1989/09/09 Initial release.
Draw a zig-zag polyline. Used for flexible ductwork.
Copyright ©, 1989-2003, by R. Robert Bell.
3914 E Bridgeport Ave
Spokane WA 99217-6933
509.487.3312
Written permission must be obtained to modify this software.
Permission is granted to copy and use this software, as long
as the code and this header are unmodified.
Exception: the software may be modified to change the values
for the following five variables only:
LayerName
LayerColor
DefaultCurve
NextPointFactor
ZigZagWidth
R. ROBERT BELL PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
R. ROBERT BELL SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.
R. ROBERT BELL DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM
WILL BE UNINTERRUPTED OR ERROR FREE.
RobertB@AcadX.com
********************************************************* ** SUBR **
|;
If you think it would be alright I can post the code, Robert posted it on another forum.
Gary
-
Here is the one I wrote, it is used in a suite (will be eventually) It can be modified to suite.
;;; ------------------------------------------------------------------------
;;; CreateFlex.lsp v1.1
;;;
;;; Copyright © January, 2007
;;; Timothy G. Spangler
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and
;;; that both that copyright notice and the limited warranty and
;;; restricted rights notice below appear in all supporting
;;; documentation.
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;; PURPOSE AND OF MERCHANTIBILITY ARE HEREBY DISCLAIMED BY THE
;;; PROGRAMMER.
;;;
;;; -----------------------------------------------------------------------
;;; ------------ COMMAND LINE FUNCTIONS
(defun c:FLEX (/)(FLEX_START))
;;; ------------ MAIN FUNCTION
(defun FLEX_START (/ *error* OldCmdEcho OldOrthoMode OldOsmode OldLunits OldLunits OldClayer OldFillMode
ActiveDoc Space FlexSize FlexStart TrunkLine EntList EntLayer StartPoint SidePoint ExtenLength LineStart
LineEnd LineAngle BlockName FlexEnd)
;;; Begin Error Handler -------------------------------------------------
(defun *error* (MSG)
(if (not (member MSG '("Function cancelled" "quit / exit abort")))
(princ (strcat "\n*** Program Error: " (strcase MSG) " ***"))
(princ "\n... Program Cancelled ...")
)
(while (< 0 (getvar "cmdactive"))
(command)
)
(FLEX_RESET_ENV)
)
;;; End Error Handler ---------------------------------------------------
(FLEX_SET_ENV)
)
;;; ------------ SETUP FLEXDUCT ENVIRONMENT SUB
(defun FLEX_SET_ENV (/)
;; Set sysetm variable
(setq OldCmdEcho (getvar "CMDECHO"))
(setq OldOrthoMode (getvar "ORTHOMODE"))
(setq OldOsmode (getvar "OSMODE"))
(setq OldLunits (getvar "LUNITS"))
(setq OldLuPrec (getvar "LUPREC"))
(setq OldClayer (getvar "CLAYER"))
(setq OldFillMode (getvar "FILLMODE"))
(setvar "CMDECHO" 0)
;; Set undo marker
(command "undo" "Begin")
(setvar "ORTHOMODE" 0)
(setvar "OSMODE" 514)
(setvar "LUNITS" 2)
(setvar "LUPREC" 4)
(setvar "FILLMODE" 0)
;; Load VLISP funtionality
(vl-load-com)
;; Set Vlisp Environment variables
(setq ActiveDoc (vla-get-activedocument (vlax-get-acad-object)))
(setq Space
(if (= (getvar "cvport") 1)
(vla-get-paperspace ActiveDoc)
(vla-get-modelspace ActiveDoc)
)
)
;; Setup layer for centerline
(FLEX_CREATE_LAYER "M-HVAC-CNTR" "Mechanical Plan - Ductwork centerline" "CENTER2" "25" "12" "0")
;; Run flex duct program
(FLEX_RUN)
)
;;; ------------ GET USER VARIABLES SUB
(defun FLEX_RUN (/)
;; Get properties from current trunk line
(while (null (setq TrunkLine (car(nentsel "\n Select trunk to add flex to: "))))
(princ "\n Duct not selected")
)
(setq EntList (entget TrunkLine))
(setq FlexLayer (cdr (assoc 8 EntList)))
;; Set flex layer
(setvar "CLAYER" FlexLayer)
;; Set tee properties
(if (equal (cdr (assoc 0 EntList)) "LINE")
(progn
(setq LineStart (cdr (assoc 10 EntList)))
(setq LineEnd (cdr (assoc 11 EntList)))
(setq LineAngle (angle LineStart LineEnd))
(setq TrunkSize (distance LineStart LineEnd))
(setq FlexStart (polar LineStart LineAngle (/ (distance LineStart LineEnd) 2)))
(setq FlexSize TrunkSize)
)
(progn
(princ "\n Trunk must be a line. ")
(FLEX_RUN)
)
)
;; Get flex direction and endpoint
(setq SidePoint (getpoint FlexStart "\n Define flex direction "))
(setq TrunkDirection (FLEX_GET_PERP LineStart LineEnd SidePoint))
(setq FlexEnd (polar FlexStart TrunkDirection 3.0))
(FLEX_BLOCK FlexSize)
(FLEX_CREATE FlexStart EndPoint FlexSize)
)
;;; ------------ CREATE FLEXDUCT SUB
(defun FLEX_CREATE (FlexStart EndPoint FlexSize / PlineEnt VLPlineObj VLPlineLength FlexDuct1 FlexDuct2
FlexDuct1Pts FlexDuct2Pts FlexCap1)
;; Create flex duct construction line (centerline)
(command "pline" FlexStart "width" FlexSize FlexSize FlexEnd "arc")
(while (> (getvar "cmdactive") 0)
(command pause)
)
(setq PlineEnt (entget(entlast)))
(setq VLPlineObj (vlax-ename->vla-object (cdr(assoc -1 PlineEnt))))
(setq VLPlineLength (fix(vlax-get VLPlineObj 'length)))
;; Change width to 0 (all for astetics)
(vlax-put VLPlineObj 'ConstantWidth 0.0)
(setvar "FILLMODE" OldFillMode)
;; Add "flex" to duct
(command "divide" (entlast) "block" BlockName "y" VLPlineLength)
;; Create flex duct sides
(setq FlexDuct1 (car (vlax-invoke VLPlineObj 'offset (/ FlexSize 2))))
(setq FlexDuct2 (car (vlax-invoke VLPlineObj 'offset (-(/ FlexSize 2)FlexSize))))
;; Get the end points of the sides
(setq FlexDuct1Pts (vlax-curve-getEndPoint FlexDuct1))
(setq FlexDuct2Pts (vlax-curve-getEndPoint FlexDuct2))
;; Create cap
(setq FlexCap1 (vlax-invoke space 'addline FlexDuct1Pts FlexDuct2Pts))
;; Set properties for centerline
(vlax-put VLPlineObj 'Layer "M-HVAC-CNTR")
(FLEX_RESET_ENV)
)
;;; ------------ CREATE FLEX LINE BLOCK SUB - DOES NOT INSERT BLOCK
(defun FLEX_BLOCK (FlexSize /)
(setq OldLunits (getvar "LUNITS"))
(setq OldLuPrec (getvar "LUPREC"))
(setvar "LUNITS" 2)
(setvar "LUPREC" 1)
(setq BlockName (strcat "FLEX-" (rtos FlexSize 5 2)))
(if (= (tblsearch "block" BlockName) nil)
(progn
(entmake
(list
(cons 0 "BLOCK")
(cons 2 BlockName)
(cons 70 64)
(cons 10 (list 0.0 0.0 0.0))
(cons 8 "0")
)
)
(entmake
(list
(cons 0 "LINE")
(cons 10 (list 0.0 (- (/ FlexSize 2) FlexSize) 0.0))
(cons 11 (list 0.0 (/ FlexSize 2) 0.0))
(cons 8 "0")
(cons 62 9)
)
)
(entmake
'((0 . "ENDBLK"))
)
)
)
(setvar "LUNITS" OldLunits)
(setvar "LUPREC" OldLuPrec)
BlockName
)
;;; ------------ LAYER CREATION ROUINE
(defun FLEX_CREATE_LAYER (Layer Descpition Linetype Thickness Color Plot / TmpList)
;; Check to see if linetype exsists
(if (= (tblsearch "ltype" Linetype) nil)
(if (FLEX_CHECK_LINETYPE (findfile "acad.lin") Linetype)
(command "linetype" "load" Linetype "acad.lin" "")
(setq Linetype "Continuous")
)
)
;;; ------------ CREATE A LIST FOR ENTMAKE
(setq TmpList
(list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 70 0)
)
)
;; Create layer name list
(setq TmpList (append TmpList (list (cons 2 Layer))))
;; Create layer color list
(setq TmpList (append TmpList (list (cons 62 (atoi Color)))))
;; Create layer linetype list
(setq TmpList (append TmpList (list (cons 6 Linetype))))
;; Create layer lineweight list
(setq TmpList (append TmpList (list (cons 370 (atoi Thickness)))))
;; Create layer plot list
(setq TmpList (append TmpList (list (cons 290 (atoi Plot)))))
;; Create layer from first item in the list
(entmake TmpList)
;; Create layer description
(if(or(= 16.1 (atof(getvar "acadver")))(< 16.1 (atof(getvar "acadver"))))
(progn
(setq VLA-Obj(vla-Add (vla-Get-Layers ActiveDoc)Layer))
(vla-Put-Description VLA-Obj Descpition)
)
)
)
;;; ------------ CHECKS TO SEE IF A LINETYPE IS AVAILIBLE
(defun FLEX_CHECK_LINETYPE (LINFile Linetype / OpenFile LineNumber CurrentLine Result)
(setq OpenFile (open LINFile "r"))
(while (setq CurrentLine (read-line OpenFile))
(if (wcmatch CurrentLine "`**")
(progn
(setq LinetypeName (substr(car(FLEX_STRING_TO_LIST CurrentLine ","))2))
(if (= (strcase Linetype) LinetypeName)
(setq Result T)
)
)
)
)
(close OpenFile)
Result
)
;;; ------------ STRING TO LIST SUB ROUTINE
(defun FLEX_STRING_TO_LIST (Stg Del / CurChr PosCnt TmpLst TmpStr)
(setq PosCnt 1
TmpStr ""
)
(repeat (1+ (strlen Stg))
(setq CurChr (substr Stg PosCnt 1))
(if (= CurChr Del)
(progn
(setq TmpLst (cons TmpStr TmpLst))
(setq TmpStr "")
)
(setq TmpStr (strcat TmpStr CurChr))
)
(setq PosCnt (1+ PosCnt))
)
(setq TmpLst (reverse TmpLst))
)
;; ------------ DEGREES TO RADIANS SUB ROUTINE
(defun FLEX_DTR (NumberOfDegrees)
(* pi (/ NumberOfDegrees 180.0))
)
(defun FLEX_RTD (NumberOfRadians)
(* 180.0 (/ NumberOfRadians pi))
)
;;; ------------ GET PERPENDICULAR POINT
(defun FLEX_GET_PERP (StartPoint EndPoint Point / EntList LineStart LineEnd LineAngle NewAngle PerpAngle)
(setq PerpStart (trans StartPoint 0 1))
(setq PerpEnd (trans EndPoint 0 1))
(setq PerpAngle (angle PerpStart PerpEnd))
(if (minusp (sin (- (angle PerpStart Point) PerpAngle))) ;determine direction
(setq NewAngle (- PerpAngle (/ pi 2))) ;if "below" -90 deg
(setq NewAngle (+ PerpAngle (/ pi 2))) ;or "above" +90 deg
)
NewAngle
)
;;; ------------ RESET SYSEM VARIABLES
(defun FLEX_RESET_ENV (/)
;; Reset system variables
(setvar "ORTHOMODE" OldOrthoMode)
(setvar "OSMODE" OldOsmode)
(setvar "LUNITS" OldLunits)
(setvar "LUPREC" OldLuPrec)
(setvar "CLAYER" OldClayer)
;; Reset undo marker
(command "undo" "End")
(setvar "CMDECHO" OldCmdEcho)
(princ)
)
;;;
;;; Echos to the command line
(princ "\n CreateFlex v1.1 ©Timothy Spangler, \n January, 2007....loaded.")
(terpri)
(princ "C:FLEX")
(print)
;;; End echo
By the way nice code Alan,
-
Gary,
Tried the routine & didn't care for it. Draws a zigzag poly line which is fine but the measure command is slow & can leave points in the drawing if it chokes. (32000+ he he)
Tim,
If I understand your routine it is based on pline widths for the duct width & the pline fill being off. I like mine on.
-
Gary,
Tried the routine & didn't care for it. Draws a zigzag poly line which is fine but the measure command is slow & can leave points in the drawing if it chokes. (32000+ he he)
Tim,
If I understand your routine it is based on pline widths for the duct width & the pline fill being off. I like mine on.
Actually it is based from a plines, offset to the duct width, it only uses pline width for visual appeal, fill is turned back on at exit or error. With fill turned off it gives the illusion of flex duct.. Then center line is creted then offset to the width. Then fillmode is turned back on. This is a trick I learned on a pline arrow creator several years ago.
-
Man CAB!!! You are effen awesome!!! :kewl:
-
Thanks, glad you like it.
-
Thanks, glad you like it.
I don't think there's anything you created that I haven't found useful. :-)
That being said, are the following possible:
Shorten the polyline by the lenghth of the collar at each end before the duct is created?
Group all the duct elements as one group?
Override layer color for ductwork?
Delete the polyline after duct creation?
-
Give this a test drive.
Note; change the settings here:
(setq FlexLayer "0") ; put your Duct layer here
(setq FlexColor acred) ; put your color over ride here or Bylayer
(setq InsulThick 0) ; to be added to duct diameter, use 2 for 1" insulation
(setq collar 6.0) ; collar length at each end
(setq DelCL t) ; delete the centerline t=Yes nil=No
(setq GroupFlex t) ; make flex duct a Group t=Yes nil=No
;;;=======================[ FlexDuct.lsp ]==============================
;;; Author: Copyright© 2007 Charles Alan Butler
;;; Contact or Updates @ www.TheSwamp.org
;;; Version: 1.6 Feb. 20,2008
;;; Purpose: Create Flex Duct from a centerline that the user picks
;;; Centerline may be anything vla-curve will handle
;;; Sub_Routines:
;;; makePline which creates a LW Polyline
;;; Restrictions: UCS is supported
;;; Duct Layer is hard coded, see var Flexlayer
;;; No error handler at this time
;;; Known Issues:
;;; Tight curves cause pline jacket distortion
;;; Added warning when this is about to occur
;;; Returns: none
;;;=====================================================================
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED ;
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR ;
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED. ;
;;; ;
;;; You are hereby granted permission to use, copy and modify this ;
;;; software without charge, provided you do so exclusively for ;
;;; your own use or for use by others in your organization in the ;
;;; performance of their normal duties, and provided further that ;
;;; the above copyright notice appears in all copies and both that ;
;;; copyright notice and the limited warranty and restricted rights ;
;;; notice below appear in all supporting documentation. ;
;;;=====================================================================
(defun c:Flex (/ 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
)
(vl-load-com)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark doc)
(vla-startundomark doc)
;; \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
;; Change these if you want
(setq FlexLayer "0") ; put your Duct layer here
(setq FlexColor acred) ; put your color over ride here or Bylayer
(setq InsulThick 0) ; to be added to duct diameter, use 2 for 1" insulation
(setq collar 6.0) ; collar length at each end
(setq DelCL t) ; delete the centerline t=Yes nil=No
(setq GroupFlex t) ; 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)
)
;; -------------------------------------
;; Get the Duct Diameter, global variable
(or duct:dia (setq duct:dia 16.0)) ; default value
(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
((= (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
)
((not (null 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))
(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 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")
)
)
)
)
) ; 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)
(vlax-release-object space)
(vlax-release-object doc)
;;----------- E N D O F L I S P ----------------------------
(princ)
)
(prompt "\nFlex Duct loaded, Enter FLEX to run.")
(princ)
<edit: code correction by CAB>
-
Fast response...I like that!
The problem I'm trying to get resolved is that the collar extends past the main duct and the diffuser (see attached images).
If you can remedy this, cool, if not, no big deal, you've done more than enough already! Thanks CAB!
-
Man, I'm a pain...grouping didn't work for me...ACAD 2008 b.t.w.
-
Fast response...I like that!
The problem I'm trying to get resolved is that the collar extends past the main duct and the diffuser (see attached images).
If you can remedy this, cool, if not, no big deal, you've done more than enough already! Thanks CAB!
Dom,
Change this in the code to zero dot zero and it will draw the collar.
(setq collar 0.0) ; collar length at
each end
-
Man, I'm a pain...grouping didn't work for me...ACAD 2008 b.t.w.
Make sure your pickstyle system var is set to 3
-
Man, I'm a pain...grouping didn't work for me...ACAD 2008 b.t.w.
Make sure your pickstyle system var is set to 3
My pick style is set to 3 and I am getting 2 polylines no groups.
but I am getting malformed list to if I hit the editor's load button. Could be a bad copy and paste on my part though.
**edit**
Yep my bad. The very last (princ) was missing its closing bracket. :-P
-
Dom,
Change this in the code to zero dot zero and it will draw the collar.
(setq collar 0.0) ; collar length at
each end
That will suffice. I did like the collars at the ends. Can't have it all, though!!!
Make sure your pickstyle system var is set to 3
It was set to 0, I changed it to 3, but it still isn't grouping them. Is it Monday?
-
Dommy,
I just returned, so make a group from the command lien using -group
note the dash.
Enter * for group name
If it creates a group please paste the sequence from the command line here.
As for the collar, you can make it any length you want but for now there is no way to set one to zero & not the other end.
I assume you got the layer & color set the way you want.
-
Bit of a tangent (it is me after all) ... the latter part of this thread reminded me you could do this (http://www.theswamp.org/index.php?topic=21521.msg260532#msg260532).
:)
-
Thanks Michael.
I'm not into groups, so you saved me from the command. 8-)
I'll investagate in the morning.
-
You're very welcome Alan, hope it contributes to our fun in some way. :)
-
I found the error in the routine. So i updated the code & also attached a copy to this post as well.
I will replace the command with Michael's method in the next version. :-)
-
I found the error in the routine. So i updated the code & also attached a copy to this post as well.
I will replace the command with Michael's method in the next version. :-)
Okay, everything works exactly the way I want it, save one thing. Is it possible to shorten the line/polyline that is used as the center of the duct by -5.125" at each end before the duct is created?
-
What is the purpose?
Do you want the duct to be shorter than the center line?
-
Fast response...I like that!
The problem I'm trying to get resolved is that the collar extends past the main duct and the diffuser (see attached images).
If you can remedy this, cool, if not, no big deal, you've done more than enough already! Thanks CAB!
-
Set collar to 0.0
(setq collar 0.0) ; collar length at each end
-
Set collar to 0.0
(setq collar 0.0) ; collar length at each end
Yeah, but I like the collars! I just added the lengthen command to the code that prompts the user to select the line at each end to shorten, but I'd rather have it done programatically from when you select the centerline. I just don't have the knowledge (nor time) right now to do it myself. It's not a big deal, as I've already dealt with it, but it would be nice.
-
Try this. Make sure you have a straight segment at each end.
-
thanks mr. cab...mr lee mac and stykeface showed me your works..this is a very good lisp, make jobs so easier and fun..hope i can learn from all of you guys..thanks
-
Thanks and welcome to The Swamp. :-)
-
wow :lol:
great work man!
cheers! :kewl:
-
I had to do some flex ducting, and didn't like the way it came out at all, and remembered that you did a routine. Works great.
Now for the nit-picking..... The most current code is not in the first post, and no way you would know unless you looked through the whole thread. I took ver 1.7, and it works great, and I think I will redo what I did.
Thanks Alan.
-
Sorry don't know why I didn't keep up with the revisions.
Added Rev 1.9 to the first post.
Will look at your revisions tomorrow.
-
Great LISP... just wondering how hard would it be make the flex center line go to it's own layer regardless of what layer the center line is on initially? It would just save having to be drawing the centre lines on the correct layer before flex generation. ( I don't delete flex centre line). We have a flex program that does this already but your flex looks twice as good so thanks.
-
Welcome to the Swamp. :-)
That should be easy to do. Will look at it today.
-
This is a great routine I just wish I had a reason to use it ...lol. CAB, you do great work it amazes me you do this sort of thing just dinking around because you're bored.
-
Slick routine Charles....now....can you make it do a 3D Flex duct?
Just kidding yo amigo....just kidding! :lmao: :lmao: :lmao: Very nice routine!!!
-
;; Get the Duct Diameter, global variable
(or duct:dia (setq duct:dia 16.0)) ; default value
may be better to keep the size of the globally?
alternatively:
(or (setq duct:dia (getenv "duct:dia")) (setq duct:dia (atof(setenv "duct:dia" (rtos 16.0)))))
-
Thanks for the interest, code updated.
Evgeniy will add in next revision.
-
FWIW, this was my old one - I took inspiration from your program CAB, but used Lines instead, its not too good compared to yours tbh:
(defun c:duct (/ *error* Line CANGE CANGO DUCT-DIA EPTE EPTO I LAST_PT1 LAST_PT2
OV P1 P2 PNTEVE PNTODD R-WID SPTE SPTO VENT VL)
(vl-load-com)
;; Lee Mac ~ 26.02.09
(defun *error* (msg)
(and ov (mapcar (function setvar) vl ov))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))
(defun Line (p1 p2)
(entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))))
(setq vl (list "FILLMODE" "PLINEWID")
ov (mapcar (function getvar) vl))
(setq duct-dia (cond (duct-dia) (10.0))
duct-dia (cond ((getdist (strcat "\nSpecify Duct Diameter <" (rtos duct-dia) "> : ")))
(duct-dia)))
(setvar "FILLMODE" 0)
(if (and (setq p1 (getpoint "\nSpecify First Point: "))
(setq p2 (getpoint p1 "\nIndicate Direction of Duct: ")))
(progn
(mapcar (function setvar) vl (list 0 duct-dia))
(setq r-Wid (/ duct-dia 6.0)
l-Rib (/ (+ duct-dia (* r-Wid 2.0)) 2.0)
s-Rib (/ duct-dia 2.0))
(command "_.pline" p1 (polar p1 (angle p1 p2) r-Wid) "_arc")
(while (= 1 (logand 1 (getvar "CMDACTIVE"))) (command pause))
(setq vEnt (vlax-ename->vla-object (entlast)) i 1.0)
(while (and (setq PntEve (vlax-curve-GetPointatDist vEnt (* i r-Wid))
PntOdd (vlax-curve-GetPointatDist vEnt (* (setq i (1+ i)) r-Wid))))
(setq cAngE (+ (/ pi 2) (angle '(0 0 0) (vlax-curve-getFirstDeriv vEnt
(vlax-curve-GetParamAtPoint vEnt PntEve)))))
(Line (setq sPtE (polar PntEve cAngE l-Rib))
(setq ePtE (polar PntEve (+ pi cAngE) l-Rib)))
(if (and last_pt1 last_pt2)
(mapcar (function Line) (list last_pt1 last_pt2) (list sPtE ePtE)))
(setq cAngO (+ (/ pi 2) (angle '(0 0 0) (vlax-curve-getFirstDeriv vEnt
(vlax-curve-GetParamAtPoint vEnt PntOdd)))))
(Line (setq sPtO (polar PntOdd cAngO s-Rib))
(setq ePtO (polar PntOdd (+ pi cAngO) s-Rib)))
(mapcar (function Line) (list sPtE ePtE) (list sPtO ePtO))
(setq last_pt1 sPtO last_pt2 ePtO i (1+ i)))
(vla-put-ConstantWidth vEnt 0.0)))
(mapcar (function setvar) vl ov)
(princ))
-
Good
-
Flex Duct with 2 point
-
Very nice, but where is the code for this one?
-
Very nice, but where is the code for this one?
Same here...... Looks like a nice routine.
-
This is a test version but the Flex2point seems to work with my limited testing.
;; Add Flex Duct by user picking 2 points on objects
;; Objects must have curve properties to obtail perpendicular angle
(defun c:Flex2Point (/ acDoc Space pt p1 p2 p1a p2a ent sFlag dia ang ang2 pl flr)
;; CAB test to see if vlax-curve can be used on an object
(defun curveOK (ent) ; returns nil if not allowed
(not (vl-catch-all-error-p
(vl-catch-all-apply 'vlax-curve-getendparam (list ent))
)
)
)
;;D. C. Broad, Jr.
;;(sideof <ray-origin> <another-point-on-ray> <point-to-be-tested>)
(defun SideOf (p1 p2 p / r)
(setq r
(cond
((equal p1 p 1e-10) 0)
(t (sin (- (angle p1 p) (angle p1 p2))))
)
)
(if (equal r 0 1e-10) 0 r)
)
;;return values
;;negative = point is to the right side of the ray
;;0 = point is on the ray
;;otherwise point is on the left side of the ray.
;;P1 should not equal P2 for meaningful results.
;; by CAB 03/22/2009
;; Expects pts to be a list of 2D or 3D points
;; Returns new pline object
(defun makePline (spc pts / norm elv pline)
(setq norm (trans '(0 0 1) 1 0 T)
elv (caddr (trans (car pts) 1 norm))
)
(setq pline
(vlax-invoke
Spc
'addLightWeightPolyline
(apply 'append
(mapcar '(lambda (pt)
(setq pt (trans pt 1 norm))
(list (car pt) (cadr pt))
)
pts
)
)
)
)
(vla-put-Elevation pline elv)
(vla-put-Normal pline (vlax-3d-point norm))
pline
)
(defun GetNextPoint (pt pn ent dia / ang sFlag)
(setq pt (vlax-curve-getclosestpointto ent pt))
(setq ang (angle '(0 0)
(vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtPoint ent pt))
)
)
(cond ; get perpendicular angle
((zerop (setq sFlag (Sideof pt (polar pt ang 10) pn)))
)
((minusp sFlag) ; right side of the ray, CW= -90
(setq ang (- ang (/ pi 2)))
)
((setq ang (+ ang (/ pi 2)))) ; CCW= +90
) ; cond
(polar pt ang dia)
)
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(setq dia 12.)
(initget "Diameter")
(setq p1 (getpoint "\nPick start point of duct."))
(setq p2 (getpoint p1 "\nPick end point of duct."))
(if (and (setq ent (car (nentselp p1)))
(curveOK ent)
)
(setq p1a (GetNextPoint p1 p2 ent dia))
(setq p1a (polar p1 (angle p1 p2) dia))
)
(if (and (setq ent (car (nentselp p2)))
(curveOK ent)
)
(setq p2a (GetNextPoint p2 p1 ent dia))
(setq p2a (polar p2 (angle p2 p1) dia))
)
(setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
(setq Space
(if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
)
(if (setq pl (makePline Space (list p1 p1a p2a p2)))
(progn
(setq flr (getvar "FILLETRAD"))
(setq cmde (getvar "CmdEcho"))
(setvar "CmdEcho" 0)
(setvar "FILLETRAD" dia)
(command "._fillet" "_P" (vlax-vla-object->ename pl))
(setvar "FILLETRAD" flr)
(setvar "CmdEcho" cmde)
(MyFlex (vlax-vla-object->ename pl)
'((DuctDiam 12)(FlexLayer "0")(FlexColor 1)))
)
)
(princ)
)
;;;=======================[ FlexDuct.lsp ]==============================
;;; Author: Copyright© 2010 Charles Alan Butler (CAB)
;;; Contact or Updates @ www.TheSwamp.org
;;; Version: 2.1 Mar 30,2010
;;; Purpose: Create Flex Duct from a centerline that the user picks
;;; Centerline may be anything vla-curve will handle
;;; Sub_Routines:
;;; makePline which creates a LW Polyline
;;; Restrictions: UCS is supported
;;; Duct Layer is hard coded, see var Flexlayer
;;; Debug only error handler at this time
;;; Known Issues:
;;; Tight curves cause pline jacket distortion
;;; Added warning when this is about to occur
;;; Returns: none
;;;=====================================================================
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED ;
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR ;
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED. ;
;;; ;
;;; You are hereby granted permission to use, copy and modify this ;
;;; software without charge, provided you do so exclusively for ;
;;; your own use or for use by others in your organization in the ;
;;; performance of their normal duties, and provided further that ;
;;; the above copyright notice appears in all copies and both that ;
;;; copyright notice and the limited warranty and restricted rights ;
;;; notice below appear in all supporting documentation. ;
;;;=====================================================================
;; Command Line Call, User picks pline centerline(s)
(defun c:Flex() (MyFlex nil ; no pre selected centerline
nil ; use default settings
))
;; Lisp entry point
(defun MyFlex (PLent variables /
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*
)
(defun *error* (msg) (vl-bt))
(vl-load-com)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark doc)
(vla-startundomark doc)
;; \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
;; Variables set by calling routine must be in pairs
;; '((FlexLayer "Duct")(FlexColor acred)(collar 0))
(if (vl-consp variables)
(mapcar (function (lambda (x)(set (car x) (cadr x)))) variables)
)
;; 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 "0" )) ; 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
(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
)
;; \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
;; -------- 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)
)
;; -------------------------------------
;; Does not work in ACAD 2000
(defun _CreateAnonymousGroup ( ) ; courtesy of Michael Puckett
(vla-add
(vla-get-groups
(vla-get-activedocument (vlax-get-acad-object))) "*")
)
;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;; S T A R T H E R E
;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(while ; Main Loop
(progn
(if PLent
(setq cl-ent (list PLent 0)) ; automatic mode
(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."))
)
)
) ; endif PLent
;;
(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
(not PLent) ; exit flag, exit if PLent
)
(t (princ "\nMissed Try again."))
) ; cond stmt
) ; progn - while
) ; while
(vla-endundomark doc)
(and space (vlax-release-object space))
(vlax-release-object doc)
;;----------- E N D O F L I S P ----------------------------
(princ)
)
(prompt "\nFlex Duct loaded, Enter FLEX to run.")
(princ)
-
Very nice Alan :-)
Only suggestion that I would offer is to include the collar length in the GetNextPoint calculation, but then this may not be desirable - I leave it in your capable hands.
Lee
-
Great program, CAB, as always. I go gently around the corners.
Pockets
-
Thanks fellas.
Lee I'm not seeing how that would work as the collar is intended to show up past the end point.
This might cause the curve to start too soon.
Perhaps I'm not understanding you.
-
Apologies Alan, it's my lack of knowledge of ducting :oops: for some reason, looking at the original GIF demo, I thought the collar protruded from the object. Thanks for the clarification. Nice work.
-
No apology necessary. I appreciate the interest. 8-)
BTW this is just a test version for those using it. I plan to incorporate the Flex2point into the MyFlex routine after more debugging. :-)
-
How difficult would it be to tweak that code a bit so that it could also be used for flexible conduit?
It basically works when I set the diameter to, say, .75 except that the sleeves are very long and those small bends tend to throw a wrench into the works.
-
What does this do for you?
<edit: old code removed>
-
What does this do for you?
:)
-
Also try this to select the center line when already created:
(defun c:Flex() (MyFlex nil ; no pre selected centerline
'((duct:dia 0.75)(collar 0.75) (FlexLayer "0")(FlexColor 1)(GroupFlex t)))
))
-
Here is a quickie :-)
<edit: old code removed>
-
That looks great, CAB. 1000 times better than my previous method.
Not knowing the ins-n-outs of flex duct, is there any reason why it extends past the endpoint of the spline? For the "flex2point" bit, it comes pretty close but I'll always trim the excess bits off leaving only what I need (indicated as "THIS" in the attached screen shot). For the "Flex" bit it extends those lines way, way, way past the endpoint. What's the reason for that, if I can ask?
Forgive my ignorance. :)
-
That looks great, CAB. 1000 times better than my previous method.
Not knowing the ins-n-outs of flex duct, is there any reason why it extends past the endpoint of the spline? For the "flex2point" bit, it comes pretty close but I'll always trim the excess bits off leaving only what I need (indicated as "THIS" in the attached screen shot). For the "Flex" bit it extends those lines way, way, way past the endpoint. What's the reason for that, if I can ask?
Forgive my ignorance. :)
Look at the variable ' collar '. You can set it to 0, and there will be no collar. This is for the Flex routine. Not sure about the ' flex2point ' one.
-
That looks great, CAB. 1000 times better than my previous method.
Not knowing the ins-n-outs of flex duct, is there any reason why it extends past the endpoint of the spline? For the "flex2point" bit, it comes pretty close but I'll always trim the excess bits off leaving only what I need (indicated as "THIS" in the attached screen shot). For the "Flex" bit it extends those lines way, way, way past the endpoint. What's the reason for that, if I can ask?
Forgive my ignorance. :)
That is a rounding error that was hidden when using larger sizes of duct. It is produced when I calc the ribs.
Wasn't an issue before but let me revisit the problem & see if I can find a solution. 8-)
-
OK. I think I fixed it. Just had to make the wiggle room proportional to the diameter.
This is a test version.
<edit: old code removed>
-
Command: flex
Duct diameter is set to 16.0
Select center line of flex duct.[Diameter]<16.0> Enter to quit.d
Specify duct diameter <16.0000>: .75
Duct diameter is set to 0.75
Select center line of flex duct.[Diameter]<0.75> Enter to quit.Backtrace:
[0.60] (VL-BT)
[1.56] (*ERROR* "bad argument type: 2D/3D point: nil")
[2.51] (_call-err-hook #<SUBR @0deae6e0 *ERROR*> "bad argument type: 2D/3D
point: nil")
[3.45] (sys-error "bad argument type: 2D/3D point: nil")
:ERROR-BREAK.40 nil
[4.37] (ax:curve-getParamAtPoint 2107327304 nil)
[5.31] (vlax-curve-getParamAtPoint <Entity name: 7d9b4348> nil)
[6.25] (MYFLEX nil nil)
[7.19] (C:FLEX)
[8.15] (#<SUBR @0deae974 -rts_top->)
[9.12] (#<SUBR @0de5535c veval-str-body> "(C:FLEX)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
:ARQ-SUBR-CALLBACK.3 (nil 0)
-
Another test version:
<edit: old code removed>
-
Dude... just... dude 8-)
Any chance of a 3D solid creation based on this?
-
Alan this is awesome! I only wish I had a use for it.
-
Thanks All.
I don't do much 3D but I'm sure it can be done. I just don't have a use for that feature.
-
Minor update, routine create only one pline where there were two before.
Add the C option to change the Collar length during the command.
Thinking of adding an option to set the collar length for the start of the flex and a separate setting for the end collar length.
<edit: old code removed>
-
OK added the separate end collar length option.
If you set the Collar option it over rides any End setting. Although during the prompt you may enter S or E and over ride the Both setting.
Collar defaults to zero if not specified.
-
That's quite interesting as a solution to the issue of Flexible ducting, I have to admit to having considered that option when I last looked at flexible ducting solutions.
The solution I eventually settled on (because I'm simple) was the old standby of Shapes and linetype definitions and the results are quite pleasing to the eye and require only one shape for all sizes of duct, and more importantly for me the Ductwork is easily modified as it's just a single line. Using this approach also allows for the output of Flexible duct sizes and lengths with a data extraction and if the end user doesnt want to see the flexible duct they can set it for center linetype (or up the ltscale so it reverts to a single line). plus it's easy to change the size of the duct as it's just a linetype.
One other benefit of a linetype solution is that as you can draw with it active you get to see the duct and make sure it's not drawn with tight bends.
Your function has collars which of course a simple linetype would not although it would be possible to build a collar shape into the linetype if needed. It might be nice if your routine would allow altering of the flexible point density so that it doesnt just scale with increases in duct size (if that makes sense)
Keep up the great work on the routine.
(http://www.theswamp.org/screens/flex.jpg)
-
Welcome to the Swamp & Thanks.
I'm on the way out of town for a week so I will be silent for a time.
I've played with shapes but did not have the success you had in appearance. (Nice Job)
I could add a reactor to give the assemble some intelligence and do all those things.
Because I do house design and not HVAC I haven't been motivated yet.
A Dialog box may also be in the routines future. Ah need more computer time. :?
-
ahhh Computer time.. The wife wont allow it I'm sure.
A Dialog would be a good way to enable options and flexibility (no p.. ok pun intended), it might pay to offer the option of a shape based duct or entity based as there would be times when having the lines actually there would be nice and times when just a shape might be preferable.
You are quite welcome to have the shape and definition file to have a play with if you like.
-
That top flex representation in reply 81 looks great. Just been told by the fearless leader that he doesn't like our current one.(The one shown on the bottom of reply 81) Is the former mentioned included in a lisp anywhere here? I think the fearless leader doesn't like how that flex sort of dominates the print on paper when there is a lot of it.
-
Hi Derek,
I've included the Shape file and the linetype definition. you can of course vary the intensity of the flexible via colour and being a linetype it's very simple to use and lends itself to splines quite nicely.
You can add more sizes in the linetype file if needed.
Richard.
-
Right. So now I should be able to include this into an existing lisp routine, or through the forums get someone to for me? I also noticed that point to point flex generation lisp. That would be great to play with too. I know nothing about lisps. I felt pretty happy with creating a toolbar shortcut with custom button for my current flex!
I have gotten it to display, but my linetype scale is messing with it somewhere. Looks like the sort of shape I think that we could use so thanks. Just need to work out best way to include it now into our drawings. A lisp would be prefferable.
-
The problem will be that Autocad can't find the shx file..
just make sur ethat the folder you have put the shx file in has been put in your support list of folders.
ie.. you may have a lisp folder that is part of your support list just add the shx file in there.
the lin file can be anywhere and not in the same location.
so long as Autocad can find the file it will work.
Richard.
-
Derek,
The zip file Richard provided contain files that should be extracted to your SUPPORT folder.
Then you may load the Flex Duct line type by locating the BS.lin file to load the line types.
Looks they will work better in a Metric file than with Imperial Units.
Oops, Richard beat me to it. 8-)
-
Thanks guys, I got it to display, but my line scale is up the creek somewhere. I can sort that though. Is there a lisp routine out there that shares a similar shape to this one? For me, a lisp is nice.
-
thanks CAB :-)
-
You're quite welcome.
-
Is the reply #59 (CAB) with the point to point flex routine the latest and greatest one? Haven't been here for a while as the old flex routine works a treat, but I'm getting a bit sick of drawing in the centre line in.
-
Shame on you, you need to get here more often. 8-)
Yes it is the latest version. http://www.theswamp.org/index.php?topic=19272.msg383107#msg383107
-
Yes I've been bad.... :oops:
I have inserted the lisp again, but have this error. [Pick end point of duct.; error: bad function: VLAX-CURVE-GETENDPARAM]
I had it working in a sense yesterday, although it did want to do the strange hookup as shown earlier in this thread. (how do I insert image? Insert image button doesn't seem to work for me)
Also- how do you define flex size with point to point? When I did have it going I was not prompted to enter a flex size like with the standard flex lisp.
One more - can this lisp be cut back so that it produces the centre line only? I would then use the flex routine to add flex later.
Thanks in advance CAB :-D
-
Ok I think I am sorting it out, I have to start flex command before flex2point works yes? I think however I have same issues in prevoius post with flex size etc. W continue to play around with it.
-
;; Add Flex Duct by user picking 2 points on objects
;; Objects must have curve properties to obtail perpendicular angle
(defun c:Flex2Point (/ acDoc Space pt p1 p2 p1a p2a ent sFlag dia ang ang2 pl flr)
;; CAB test to see if vlax-curve can be used on an object
(defun curveOK (ent) ; returns nil if not allowed
(not (vl-catch-all-error-p
(vl-catch-all-apply 'vlax-curve-getendparam (list ent))
)
)
)
;;D. C. Broad, Jr.
;;(sideof <ray-origin> <another-point-on-ray> <point-to-be-tested>)
(defun SideOf (p1 p2 p / r)
(setq r
(cond
((equal p1 p 1e-10) 0)
(t (sin (- (angle p1 p) (angle p1 p2))))
)
)
(if (equal r 0 1e-10) 0 r)
)
;;return values
;;negative = point is to the right side of the ray
;;0 = point is on the ray
;;otherwise point is on the left side of the ray.
;;P1 should not equal P2 for meaningful results.
;; by CAB 03/22/2009
;; Expects pts to be a list of 2D or 3D points
;; Returns new pline object
(defun makePline (spc pts / norm elv pline)
(setq norm (trans '(0 0 1) 1 0 T)
elv (caddr (trans (car pts) 1 norm))
)
(setq pline
(vlax-invoke
Spc
'addLightWeightPolyline
(apply 'append
(mapcar '(lambda (pt)
(setq pt (trans pt 1 norm))
(list (car pt) (cadr pt))
)
pts
)
)
)
)
(vla-put-Elevation pline elv)
(vla-put-Normal pline (vlax-3d-point norm))
pline
)
(defun GetNextPoint (pt pn ent dia / ang sFlag)
(setq pt (vlax-curve-getclosestpointto ent pt))
(setq ang (angle '(0 0)
(vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtPoint ent pt))
)
)
(cond ; get perpendicular angle
((zerop (setq sFlag (Sideof pt (polar pt ang 10) pn)))
)
((minusp sFlag) ; right side of the ray, CW= -90
(setq ang (- ang (/ pi 2)))
)
((setq ang (+ ang (/ pi 2)))) ; CCW= +90
) ; cond
(polar pt ang dia)
)
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(setq dia 12.)
(initget "Diameter")
(setq p1 (getpoint "\nPick start point of duct."))
(setq p2 (getpoint p1 "\nPick end point of duct."))
(if (and (setq ent (car (nentselp p1)))
(curveOK ent)
)
(setq p1a (GetNextPoint p1 p2 ent dia))
(setq p1a (polar p1 (angle p1 p2) dia))
)
(if (and (setq ent (car (nentselp p2)))
(curveOK ent)
)
(setq p2a (GetNextPoint p2 p1 ent dia))
(setq p2a (polar p2 (angle p2 p1) dia))
)
(setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
(setq Space
(if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
)
(if (setq pl (makePline Space (list p1 p1a p2a p2)))
(progn
(setq flr (getvar "FILLETRAD"))
(setq cmde (getvar "CmdEcho"))
(setvar "CmdEcho" 0)
(setvar "FILLETRAD" dia)
(command "._fillet" "_P" (vlax-vla-object->ename pl))
(setvar "FILLETRAD" flr)
(setvar "CmdEcho" cmde)
(c:Flex (vlax-vla-object->ename pl)
'((DuctDiam 12)(FlexLayer "0")(FlexColor 1)))
)
)
(princ)
)
;;;=======================[ FlexDuct.lsp ]==============================
;;; Author: Copyright© 2007 Charles Alan Butler
;;; Contact or Updates @ www.TheSwamp.org
;;; Version: 1.7 Feb. 21,2008
;;; Purpose: Create Flex Duct from a centerline that the user picks
;;; Centerline may be anything vla-curve will handle
;;; Sub_Routines:
;;; makePline which creates a LW Polyline
;;; Restrictions: UCS is supported
;;; Duct Layer is hard coded, see var Flexlayer
;;; No error handler at this time
;;; Known Issues:
;;; Tight curves cause pline jacket distortion
;;; Added warning when this is about to occur
;;; Returns: none
;;;=====================================================================
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED ;
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR ;
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED. ;
;;; ;
;;; You are hereby granted permission to use, copy and modify this ;
;;; software without charge, provided you do so exclusively for ;
;;; your own use or for use by others in your organization in the ;
;;; performance of their normal duties, and provided further that ;
;;; the above copyright notice appears in all copies and both that ;
;;; copyright notice and the limited warranty and restricted rights ;
;;; notice below appear in all supporting documentation. ;
;;;=====================================================================
;;; Modified by Lee Mac to force Centerline to specified layer.
(defun c:Flex (/ 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 CentLayer CentColor Centerobj
)
(vl-load-com)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark doc)
(vla-startundomark doc)
;; \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
;; Change these if you want
(setq FlexLayer "M_flex") ; put your Duct layer here
(setq CentLayer "M_centre") ; Put your Centerline layer here
(setq FlexColor 45) ; put your color over ride here or acBylayer
(setq CentColor acred) ;; put your color override here or acByLayer
(setq InsulThick 0) ; to be added to duct diameter, use 2 for 1" insulation
(setq collar 6.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)
)
;; -------------------------------------
; Lee Mac Mod {
(mapcar
(function
(lambda (layer) (or (tblsearch "LAYER" layer)
(vla-add (vla-get-Layers doc) layer))))
(list FlexLayer CentLayer))
; } End of Lee Mac Mod
;; Get the Duct Diameter, global variable
(or duct:dia (setq duct:dia 200.0)) ; default value
(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
((= (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
)
((not (null 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 0.8))
)
;; Lee Mac Mod {
(vla-put-layer
(setq centerobj (vlax-ename->vla-object cl-ent)) CentLayer)
(vla-put-color centerobj centcolor)
;; } End of Lee Mac Mod
;; centerline length
(setq cl-len (vlax-curve-getdistatparam
cl-ent
(vlax-curve-getendparam cl-ent)
)
cl-len (- cl-len (* collar 2.0))
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 collar ;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))
(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 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")
)
)
)
)
) ; 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)
(vlax-release-object space)
(vlax-release-object doc)
;;----------- E N D O F L I S P ----------------------------
(princ)
)
(prompt "\nFlex Duct loaded, Enter FLEX to run.")
(princ)
Ok I've put in what I have come up with. I just dumped my flex routine into the flex2point code posted here. I had to change myflex to c:flex to get it to work. If anyone cares to test it you will see the flex part works ok, but the flex2point does just a line now with no flex. The line path generated needs fixing (radius size and initial stright length) but I can sort that later I hope.
Sorry if I'm stuffing anyone around but I am flying blind a bit here. It is however worth pursuing as I think this point to point lisp could save a lot of time in this drawing office.
-
This line is in the wrong place:
(vl-load-com)
Put it above the following line:
(defun c:Flex()
Most people who use lisp add that to there acaddoc.lsp file.
Back on Monday....
-
Thanks. Got this error now. 'Pick end point of duct.; error: too many arguments'
What is the acaddoc.lsp file? More importantly, is there some literature anywhere to help with learning this stuff?
Thanks for the feedback. Have a good weekend Charles.
-
What is the acaddoc.lsp file? More importantly, is there some literature anywhere to help with learning this stuff?
Upon opening a drawing AutoCAD will search all support paths + the working directory for a file called the ACADDOC.lsp and load the first one it finds.
Hence most users will load their routines/execute startup functions [such as (vl-load-com) ] using the ACADDOC.lsp as it is a more stable method than the Startup Suite.
Coincidentally, I've just added a snippet about the ACADDOC.lsp to my site, although it probably needs a going over, it may be of some help to you:
http://lee-mac.com/runlisp.html (http://lee-mac.com/runlisp.html)
-
If autocad loads the first lisp it finds, using the acaddoc.lsp described, does this mean that only the one lisp routine will be loaded?
-
If autocad loads the first lisp it finds, using the acaddoc.lsp described, does this mean that only the one lisp routine will be loaded?
It will load the first ACADDOC.lsp file it finds, this file can load many routines.
Two main ways users tend to load routines using the ACADDOC.lsp is either using the 'load' function hence:
(load "C:\\MyFolder\\MyLISP.lsp" "Load Failed")
(Path not required if lsp is in support path).
Or using Autoload:
(autoload "C:\\MyFolder\\MyLISP.lsp" '("Command1" "Command2"))
This method only loads a small fragment of code at startup, then demand loads the full LISP program when the user enters the command at the command line.
Lee
-
(load "C:\\MyFolder\\MyLISP.lsp"[b] "Load Failed"[/b])
How does the error work in the code. I understand that if the file is not found and loaded, it returns the error. But how does it work? More on a nut and bolt level of how does it work.
-
(load "C:\\MyFolder\\MyLISP.lsp"[b] "Load Failed"[/b])
How does the error work in the code. I understand that if the file is not found and loaded, it returns the error. But how does it work? More on a nut and bolt level of how does it work.
Command: (load "pizza.lsp" nil)
nil
Command: (load "pizza.lsp")
Error: LOAD failed: "pizza.lsp"
Command: (load "pizza.lsp" "nope")
"nope"
Command: (load "distanceinquiry.lsp" "nope")
C:DISTANCEINQUIRY
-
Alanjt,
I understand that part of and I can test for it and have.
I want to look under the hood to see how all the little sub-assemblies work and follow it thru. Or am I not allowed to look under the hood?
-
I"ve been using this routine since ACAD 2012 with no issues. Recently I upgraded to AutoCAD 2015 and lisp is not working anymore. It returns the following error:
uct diameter is set to 16.0
Select center line of flex duct.[Diameter]<16.0> Enter to quit.Backtrace:
[0.48] (VL-BT)
[1.44] (*ERROR* "bad function: VLAX-CURVE-GETPOINTATPARAM")
[2.39] (_call-err-hook #<SUBR @000000a1e50db548 *ERROR*> "bad function: VLAX-CURVE-GETPOINTATPARAM")
[3.33] (sys-error "bad function: VLAX-CURVE-GETPOINTATPARAM")
:ERROR-BREAK.28 nil
[4.25] (VL-CATCH-ALL-APPLY VLAX-CURVE-GETPOINTATPARAM (<Entity name: 7ff74ad04db0> 0.0))
[5.19] (C:FLEX)
[6.15] (#<SUBR @000000a1e50dbb38 -rts_top->)
[7.12] (#<SUBR @000000a1e4fb8700 veval-str-body> "(C:FLEX)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
:ARQ-SUBR-CALLBACK.3 (nil 0)
Any idea?
-
It may not be ACAD2015 but how far the geometry is from the origin.
The Curve functions do not play well when too far from 0,0,0.
So try creating the duct near 0,0,0 and see if you get the same error.
Also are you using version 2.2?
-
Thanks for your quick answer. I was not using version 2.2, but 2.0. I tried near to 0,0,0 and received the same error.
I think is related to AutoCAD 2015 because I was reading an article the other day informing developers that Lisp functions and command call routines were changed in ACAD 2015.
-
Thanks for your quick answer. I was not using version 2.2, but 2.0. I tried near to 0,0,0 and received the same error.
I think is related to AutoCAD 2015 because I was reading an article the other day informing developers that Lisp functions and command call routines were changed in ACAD 2015.
Are you able to provide a link to that article ??
-
This is the article:
http://through-the-interface.typepad.com/through_the_interface/2014/03/autocad-2015-calling-commands.html
-
This is the article:
http://through-the-interface.typepad.com/through_the_interface/2014/03/autocad-2015-calling-commands.html
I thought that may have been the one. :)
Kean is discussing the consequences of making fibres inactive, and how that affects Commands. I doubt if that would affect the VisualLisp COM function calls.
I'll ask Kean to comment on this.
-
The functions are in the help document. Not that that is proof of anything. :)
http://help.autodesk.com/view/ACD/2015/ENU/?guid=GUID-8FF6D3D5-7EA5-4E9A-8A61-295C0562E7AE (http://help.autodesk.com/view/ACD/2015/ENU/?guid=GUID-8FF6D3D5-7EA5-4E9A-8A61-295C0562E7AE)
-
It's late here so tomorrow I will add some debug code to the routine to see if we can narrow down the cause of the error.
That is if it's in the routine and not ACAD2015..
Good night
-
I was trying to help by pointing out it may be an ACAD 2015 issue. The real fact is that I have no clue of programming and would like to use the flex duct lisp in some drawings I need to do. I will try tomorrow or Sunday to try with a friend computer with ACAD 2014 and will notify the results.
Thanks again CAB for your routine and your assistance, good night.
-
I tried the routine in 2015
This was with metric units set.
(http://i59.tinypic.com/1z5p3wy.png)
-
Missing (vl-load-com) perhaps?
-
Missing (vl-load-com) perhaps?
I checked that too Owen, It's the first line in the source :)
-
Kean is discussing the consequences of making fibres inactive, and how that affects Commands. I doubt if that would affect the VisualLisp COM function calls.
I'll ask Kean to comment on this.
I can't see how this relates to the removal of fibers. If someone can post the steps to reproduce the problem I can ask someone to take a look, however.
Kean
-
Quick look at the code and the (command "._select" "Au" does not work for me in ACAD2006.
Also a Break command in there but that's it. No Vlax stuff in there.
Maybe the command calls changed the prompt order or options.
-
As far as the vlax-curve problem I would try Repair or Reinstall Autocad to see if that fixed the problem.
-
This works for me in 2015 with no problems. It's not how we show Flex Duct, as we use SDUCT from Ductisoft to draw our ductwork; however, this will be useful for some details and such.
-
Good job. CAB
-
That's some nice work, new toys are always fun, thanks CAB!
have not seen you in a while deegeecees? RU still making music?
-
hi guys! newbie here..does anyone have the code for this flex lisp? the one in the middle with the round edge.
(http://www.theswamp.org/screens/flex.jpg)
-
@rbeldua:
As explained here (http://www.theswamp.org/index.php?topic=19272.msg385756#msg385756), this was created using a linetype and a shape instead of Lisp code.
-
Modified my lisp with an option for rounded sides.
Not thoroughly tested, but give it a try.
-
As explained here (http://www.theswamp.org/index.php?topic=19272.msg385756#msg385756), this was created using a linetype and a shape instead of Lisp code.
sorry for a very delayed reply, about 7 months :-o , I was transfered to another site where internet is kinda limited to officials only. I was hoping this kinda flex in the middle screenshot will do it for me as I worked with tons of HVAC drawings. Anyways I will try CAB's Flex 23. Thanks
Modified my lisp with an option for rounded sides.
Not thoroughly tested, but give it a try.
Thanks CAB, may not be similar to the one in the middle of the screenshot but this will do and thanks for the effort. I will use it :-)
-
You are welcome.
Glad my efforts were not in vain.
-
Thanks again cab, your flex 23 lisp has a lot of uses. it's been a lot more easier doin a job now. :-)
thought I post some good uses of flex 23
(http://i1112.photobucket.com/albums/k499/rbeldua/1234_zpszha8gdzu.png) (http://s1112.photobucket.com/user/rbeldua/media/1234_zpszha8gdzu.png.html)
(http://i1112.photobucket.com/albums/k499/rbeldua/123_zpswll9rp4b.png) (http://s1112.photobucket.com/user/rbeldua/media/123_zpswll9rp4b.png.html)
-
Looks great, glad it's working for you.
I use it as well on houses for AC ducts.