Author Topic: Prog - Double line flexduct  (Read 4278 times)

0 Members and 1 Guest are viewing this topic.

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
Prog - Double line flexduct
« on: November 15, 2006, 01:32:58 PM »
I have been working on this since yesterday, and with a little help from som swampers (CAB Stephen, Luis) I was able to create this.

There is one problem and it depends on the zoom.  If you try to create the flex while zoomed way out it isn't created perpendicular to the trunk, (except if you dont select a point on the trunk - make sense).  Anyway maybe someone here can check it out maybe there is a varible that I can check for ??)
Code: [Select]
;;; ------------------------------------------------------------------------
;;;    CreateFlex.lsp v1.0
;;;
;;;    Copyright © November, 2006
;;;    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 (/)(START_FLEX))

;;; ------------ MAIN FUNCTION
(defun START_FLEX (/
*error*
OldCmdEcho
OldOrthoMode
OldOsmode
OldLunits
OldLunits
OldClayer
OldFillMode
ActiveDoc
Space
FlexSize
TrunkLine
EntList
EntLayer
StartPoint

ExtenLength




Angle+90
Angle-90
BlockName
)

;;; 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 OldLunits (getvar "LUPREC"))
(setq OldClayer (getvar "CLAYER"))
(setq OldFillMode (getvar "FILLMODE"))
(setvar "CMDECHO" 0)
(setvar "ORTHOMODE" 0)
(setvar "OSMODE" 514)
(setvar "LUNITS" 2)
(setvar "LUPREC" 4)
(setvar "FILLMODE" 0)

;; Set undo marker
(command "undo" "Begin")

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

;; Run flex duct program
(RUN_FLEX)
)
;;; ------------ GET USER VARIABLES SUB
(defun RUN_FLEX (/)

(if(not(setq FlexSize (getreal " Enter flexduct size <6\">: ")))
(setq FlexSize 6.0)
)
(while (null (setq TrunkLine (nentsel "\n Select trunk to add flexduct to: ")))
(princ "\n  Duct not selected")
)
(setq EntList (entget (car TrunkLine)))
(setq EntLayer (cdr (assoc 8 EntList)))
(if (equal (cdr (assoc 0 EntList)) "LINE")
(progn
(setq StartPoint (getpoint "\n Select flexduct starting point: "))
(setq SidePoint (getpoint "\n Select side of trunk for flexduct: "))
(setq ExtenLength 2.0)
(setq LineStart (trans (cdr (assoc 10 EntList)) 0 1))
(setq LineEnd (trans (cdr (assoc 11 EntList)) 0 1))
(setq LineAngle (angle LineStart LineEnd))
;; Determine direction
(if (minusp (sin (- (angle LineStart SidePoint) LineAngle)))
;if "below" -90 deg
(setq NewAngle (- LineAngle (/ pi 2)))
;or "above" +90 deg
(setq NewAngle (+ LineAngle (/ pi 2)))
)
(setq EndPoint (polar StartPoint NewAngle ExtenLength))
)
)
(princ newangle)
(princ Lineangle)

;; Setup user defined variable
(setq Angle+90 (+ NewAngle (FLEX_DTR 90)))
(setq Angle-90 (- NewAngle (FLEX_DTR 90)))

(setvar "CLAYER" EntLayer)
(CREATE_FLEX_BLOCK FlexSize)
(CREATE_FLEX StartPoint EndPoint FlexSize)
)
;;; ------------ CREATE FLEXDUCT SUB
(defun CREATE_FLEX (StartPoint EndPoint FlexSize /
PlineEnt
VLPlineObj
VLPlineLength
FlexDuct1
FlexDuct2
FlexDuct1Pts
FlexDuct2Pts
FlexCap1
)

;; Create flex duct construction line (centerline)
(command "pline" StartPoint "width" FlexSize FlexSize EndPoint "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 last 2 points of the coordinates (the end points)
(setq FlexDuct1Pts (vlax-get FlexDuct1 'coordinates))
(setq FlexDuct1Pts (list(nth (- (length FlexDuct1Pts)2)FlexDuct1Pts)(nth (- (length FlexDuct1Pts)1)FlexDuct1Pts)0.0))
(setq FlexDuct2Pts (vlax-get FlexDuct2 'coordinates))
(setq FlexDuct2Pts (list(nth (- (length FlexDuct2Pts)2)FlexDuct2Pts)(nth (- (length FlexDuct2Pts)1)FlexDuct2Pts)0.0))

;; Create cap
(setq FlexCap1 (vlax-invoke space 'addline FlexDuct1Pts FlexDuct2Pts))

;; Delete construction line
(vlax-invoke VLPlineObj 'delete)

(FLEX_RESET_ENV)
)
;;; ------------ CREATE FLEX LINE BLOCK SUB - DOES NOT INSERT BLOCK
(defun CREATE_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
'((0 . "LAYER")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbLayerTableRecord")
(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(TGS:Stringtolist CurrentLine ","))2))
(if (= (strcase Linetype) LinetypeName)
(setq Result T)
)
)
)
)
(close OpenFile)
Result
)
;;; ------------ STRING TO LIST SUB ROUTINE
(defun TGS:StringToList (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))
)

;;; ------------ RESET SYSEM VARIABLES
(defun FLEX_RESET_ENV (/)

;; Reset system variables
(setvar "CMDECHO" OldCmdEcho)
(setvar "ORTHOMODE" OldOrthoMode)
(setvar "OSMODE" OldOsmode)
(setvar "LUNITS" OldLunits)
(setvar "LUPREC" OldLuPrec)
(setvar "CLAYER" OldClayer)

;; Reset undo marker
(command "undo" "End")
(princ)
)
;;;
;;; Echos to the command line
(princ "\n CreateFlexduct v1.0 ©Timothy Spangler, \n  November, 2006....loaded.")
(terpri)
(princ "C:FLEX")
(print)
;;; End echo
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
Re: Prog - Double line flexduct
« Reply #1 on: November 15, 2006, 01:34:03 PM »
I also have this jem for creating trunks:

Code: [Select]
;;; ------------------------------------------------------------------------
;;;    CreateDuct.lsp v1.0
;;;
;;;    Copyright © November, 2006
;;;    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:DUCT (/) (START_DUCT))

;;; ------------ MAIN FUNCTION
(defun START_DUCT ( / *error*  Angle+90 Angle-90 ActiveDoc DuctAlign DuctAgnle DuctHeight DuctWidth DuctStyle DuctType OldClayer OldCmdEcho Space)

  ;;; 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)
)
(princ)
)
;;; End Error Handler ---------------------------------------------------
(DUCT_SET_ENV)
)
;;; ------------ SET ENVIROMENT BEFORE LAUNCH
(defun DUCT_SET_ENV(/)

(setq OldClayer (getvar "CLAYER"))
(setq OldCmdEcho (getvar "CMDECHO"))

(setvar "CMDECHO" 0)

(vl-load-com)
(setq ActiveDoc (vla-get-activedocument (vlax-get-acad-object)))
(setq Space
(if (= (getvar "cvport") 1)
(vla-get-paperspace ActiveDoc)
(vla-get-modelspace ActiveDoc)
)
)
;; Run duct
(RUN_DUCT)
)
;;; ------------ RUN DUCT SUB ROUTINE - GET VARIABLES
(defun RUN_DUCT (/)

;; Get duct width
(setq DuctWidth (getreal "Enter duct width: "))
;; Get duct height
(setq DuctHeight (getreal "Enter duct height: "))

;; Get duct style
(initget 1 "Square s S Round r R")
(setq DuctStyle (getkword "Enter duct style: (Square/Round)"))

;; Get duct type
(initget 1 "Supply s S Return r R Exhaust e E Dust d D")
(setq DuctType (getkword "Enter duct type: (Supply/Return/Exhaust/Dust)"))

;; Get duct alignment
(initget 1 "Center c C Top t T Bottom b B")
(setq DuctAlign (getkword "Enter duct alignment: (Center/Top/Bottom)"))

;; Get insulation
(initget 1 "None Inside Outside Both")
(setq DuctInsul (getkword "Insulation options: (None/Inside/Oustside/Both)"))

;; Create duct
(CREATE_DUCT DuctType DuctWidth DuctHeight DuctAlign DuctInsul)
)
;;; ------------ LAYER CREATION ROUINE
(defun DUCT_CREATE_LAYER (Layer Descpition Linetype Thickness Color Plot / TmpList)

;; Check to see if linetype exsists
(if (= (tblsearch "ltype" Linetype) nil)
(if (DUCT_CHECK_LINETYPE (findfile "acad.lin") Linetype)
(command "linetype" "load" Linetype "acad.lin" "")
(setq Linetype "Continuous")
)
)
;;; ------------ CREATE A LIST FOR ENTMAKE
(setq TmpList
'((0 . "LAYER")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbLayerTableRecord")
(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 DUCT_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(TGS:Stringtolist CurrentLine ","))2))
(if (= (strcase Linetype) LinetypeName)
(setq Result T)
)
)
)
)
(close OpenFile)
Result
)
;;; ------------ STRING TO LIST SUB ROUTINE
(defun TGS:StringToList (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))
)
;;; ------------ CREATE DUCT SUB ROUTINE
(defun CREATE_DUCT (DuctType DuctWidth DuctHeight DuctAlign DuctInsul / DuctLine1 DuctLine2 DuctPoint1 DuctPoint2 DuctPoint3 DuctPoint4 InsulLine1 InsulLine2 InsulLine3 InsulLine4 InsulPoint1 InsulPoint2 InsulPoint3 InsulPoint4 InsulPoint5 InsulPoint6 InsulPoint7 InsulPoint8 StartPoint1 StartPoint2)

;; Setup Points
(setq StartPoint1 (getpoint "\nDefine start point of duct: "))
(setq StartPoint2 (getpoint StartPoint1 "  \nDefine end point of duct: "))

;; Setup angles
(setq DuctAngle (angle StartPoint1 StartPoint2))
(setq Angle+90 (+ DuctAngle (DUCT_DTR 90)))
(setq Angle-90 (- DuctAngle (DUCT_DTR 90)))

(cond
((= (strcase DuctAlign) "CENTER")
;; Get Duct Center Point
(setq MidPoint1 (polar StartPoint1 DuctAngle(/ (distance StartPoint1 StartPoint2)2)))
;; Get Duct Points
(setq DuctPoint1 (polar StartPoint1 Angle+90 (/ DuctWidth 2)))
(setq DuctPoint2 (polar StartPoint2 Angle+90 (/ DuctWidth 2)))
(setq DuctPoint3 (polar StartPoint1 Angle-90 (/ DuctWidth 2)))
(setq DuctPoint4 (polar StartPoint2 Angle-90 (/ DuctWidth 2)))

;; Get Insulation Points
(if(or(= (strcase DuctInsul) "INSIDE")(= (strcase DuctInsul) "BOTH"))
(progn
(setq InsulPoint1 (polar StartPoint1 Angle+90 (- 1 (/ DuctWidth 2))))
(setq InsulPoint2 (polar StartPoint2 Angle+90 (- 1 (/ DuctWidth 2))))
(setq InsulPoint3 (polar StartPoint1 Angle-90 (- 1 (/ DuctWidth 2))))
(setq InsulPoint4 (polar StartPoint2 Angle-90 (- 1 (/ DuctWidth 2))))
)
)
(if(or(= (strcase DuctInsul) "OUTSIDE")(= (strcase DuctInsul) "BOTH"))
(progn
(setq InsulPoint5 (polar StartPoint1 Angle+90 (+ 1 (/ DuctWidth 2))))
(setq InsulPoint6 (polar StartPoint2 Angle+90 (+ 1 (/ DuctWidth 2))))
(setq InsulPoint7 (polar StartPoint1 Angle-90 (+ 1 (/ DuctWidth 2))))
(setq InsulPoint8 (polar StartPoint2 Angle-90 (+ 1 (/ DuctWidth 2))))
)
)
)
((= (strcase DuctAlign) "BOTTOM")
;; Get Duct Center Point
(setq MidPoint1 (polar (polar StartPoint1 DuctAngle(/ (distance StartPoint1 StartPoint2)2)) Angle+90 (/ DuctWidth 2)))
;; Get Duct Points
(setq DuctPoint1 StartPoint1)
(setq DuctPoint2 StartPoint2)
(setq DuctPoint3 (polar StartPoint1 Angle+90 DuctWidth))
(setq DuctPoint4 (polar StartPoint2 Angle+90 DuctWidth))

;; Get Insulation Points
(if(or(= (strcase DuctInsul) "INSIDE")(= (strcase DuctInsul) "BOTH"))
(progn
(setq InsulPoint1 (polar StartPoint1 Angle+90 1))
(setq InsulPoint2 (polar StartPoint2 Angle+90 1))
(setq InsulPoint3 (polar StartPoint1 Angle+90 (- DuctWidth 1)))
(setq InsulPoint4 (polar StartPoint2 Angle+90 (- DuctWidth 1)))
)
)
(if(or(= (strcase DuctInsul) "OUTSIDE")(= (strcase DuctInsul) "BOTH"))
(progn
(setq InsulPoint5 (polar StartPoint1 Angle-90 1))
(setq InsulPoint6 (polar StartPoint2 Angle-90 1))
(setq InsulPoint7 (polar StartPoint1 Angle+90 (+ DuctWidth 1)))
(setq InsulPoint8 (polar StartPoint2 Angle+90 (+ DuctWidth 1)))
)
)
)
((= (strcase DuctAlign) "TOP")
;; Get Duct Center Point
(setq MidPoint1 (polar (polar StartPoint1 DuctAngle(/ (distance StartPoint1 StartPoint2)2)) Angle-90 (/ DuctWidth 2)))
;; Get Duct Points
(setq DuctPoint1 StartPoint1)
(setq DuctPoint2 StartPoint2)
(setq DuctPoint3 (polar StartPoint1 Angle-90 DuctWidth))
(setq DuctPoint4 (polar StartPoint2 Angle-90 DuctWidth))

;; Get Insulation Points
(if(or(= (strcase DuctInsul) "INSIDE")(= (strcase DuctInsul) "BOTH"))
(progn
(setq InsulPoint1 (polar StartPoint1 Angle-90 1))
(setq InsulPoint2 (polar StartPoint2 Angle-90 1))
(setq InsulPoint3 (polar StartPoint1 Angle-90 (- DuctWidth 1)))
(setq InsulPoint4 (polar StartPoint2 Angle-90 (- DuctWidth 1)))
)
)
(if(or(= (strcase DuctInsul) "OUTSIDE")(= (strcase DuctInsul) "BOTH"))
(progn
(setq InsulPoint5 (polar StartPoint1 Angle+90 1))
(setq InsulPoint6 (polar StartPoint2 Angle+90 1))
(setq InsulPoint7 (polar StartPoint1 Angle-90 (+ DuctWidth 1)))
(setq InsulPoint8 (polar StartPoint2 Angle-90 (+ DuctWidth 1)))
)
)
)
)

;; Draw Duct
(setq DuctLine1 (vlax-invoke space 'addline DuctPoint1 DuctPoint2))
(setq DuctLine2 (vlax-invoke space 'addline DuctPoint3 DuctPoint4))
(setq DuctLine3 (vlax-invoke space 'addline DuctPoint1 DuctPoint3))
(setq DuctLine4 (vlax-invoke space 'addline DuctPoint2 DuctPoint4))

;; Draw Insulation
(if (= (strcase DuctInsul) "INSIDE")
(progn
(setq InsulLine1 (vlax-invoke space 'addline InsulPoint1 InsulPoint2))
(setq InsulLine2 (vlax-invoke space 'addline InsulPoint3 InsulPoint4))
)
)
(if (= (strcase DuctInsul) "OUTSIDE")
(progn
(setq InsulLine3 (vlax-invoke space 'addline InsulPoint5 InsulPoint6))
(setq InsulLine4 (vlax-invoke space 'addline InsulPoint7 InsulPoint8))
)
)
(if (= (strcase DuctInsul) "BOTH")
(progn
(setq InsulLine1 (vlax-invoke space 'addline InsulPoint1 InsulPoint2))
(setq InsulLine2 (vlax-invoke space 'addline InsulPoint3 InsulPoint4))
(setq InsulLine3 (vlax-invoke space 'addline InsulPoint5 InsulPoint6))
(setq InsulLine4 (vlax-invoke space 'addline InsulPoint7 InsulPoint8))
)
)

(cond
((= (strcase DuctType) "SUPPLY")
;; Setup layer
(DUCT_CREATE_LAYER "M-HVAC-SUPP" "Supply ductwork" "Continuous" "25" "4" "1")
;; Set duct line properties
(vlax-put DuctLine1 'Layer "M-HVAC-SUPP")
(vlax-put DuctLine1 'Linetype "BYLAYER")
(vlax-put DuctLine2 'Layer "M-HVAC-SUPP")
(vlax-put DuctLine2 'Linetype "BYLAYER")
(vlax-put DuctLine3 'Layer "M-HVAC-SUPP")
(vlax-put DuctLine3 'Linetype "BYLAYER")
(vlax-put DuctLine4 'Layer "M-HVAC-SUPP")
(vlax-put DuctLine4 'Linetype "BYLAYER")
)
((= (strcase DuctType) "RETURN")
;; Setup layer
(DUCT_CREATE_LAYER "M-HVAC-RETN" "Return ductwork" "Continuous" "50" "23" "1")
;; Set duct line properties
(vlax-put DuctLine1 'Layer "M-HVAC-RETN")
(vlax-put DuctLine1 'Linetype "BYLAYER")
(vlax-put DuctLine2 'Layer "M-HVAC-RETN")
(vlax-put DuctLine2 'Linetype "BYLAYER")
(vlax-put DuctLine3 'Layer "M-HVAC-RETN")
(vlax-put DuctLine3 'Linetype "BYLAYER")
(vlax-put DuctLine4 'Layer "M-HVAC-RETN")
(vlax-put DuctLine4 'Linetype "BYLAYER")
)
((= (strcase DuctType) "EXHAUST")
;; Setup layer
(DUCT_CREATE_LAYER "M-DUCT-EXHS" "Exhaust ductwork" "Continuous" "50" "83" "1")
;; Set duct line properties
(vlax-put DuctLine1 'Layer "M-DUCT-EXHS")
(vlax-put DuctLine1 'Linetype "BYLAYER")
(vlax-put DuctLine2 'Layer "M-DUCT-EXHS")
(vlax-put DuctLine2 'Linetype "BYLAYER")
(vlax-put DuctLine3 'Layer "M-DUCT-EXHS")
(vlax-put DuctLine3 'Linetype "BYLAYER")
(vlax-put DuctLine4 'Layer "M-DUCT-EXHS")
(vlax-put DuctLine4 'Linetype "BYLAYER")
)
((= (strcase DuctType) "DUST")
;; Setup layer
(DUCT_CREATE_LAYER "M-DUCT-DUST" "Dust and fume collection ductwork" "Continuous" "50" "203" "1")
;; Set duct ine properties
(vlax-put DuctLine1 'Layer "M-DUCT-DUST")
(vlax-put DuctLine1 'Linetype "BYLAYER")
(vlax-put DuctLine2 'Layer "M-DUCT-DUST")
(vlax-put DuctLine2 'Linetype "BYLAYER")
(vlax-put DuctLine3 'Layer "M-DUCT-DUST")
(vlax-put DuctLine3 'Linetype "BYLAYER")
(vlax-put DuctLine4 'Layer "M-DUCT-DUST")
(vlax-put DuctLine4 'Linetype "BYLAYER")
)
)

;; Setup layer
(DUCT_CREATE_LAYER "M-DUCT-INSL" "Ductwork Insulation" "HIDDEN2" "18" "200" "1")

;; Set Insulation Line properties
(if (or (= (strcase DuctInsul) "INSIDE")(= (strcase DuctInsul) "BOTH"))
(progn
(vlax-put InsulLine1 'Layer "M-DUCT-INSL")
(vlax-put InsulLine1 'Linetype "BYLAYER")
(vlax-put InsulLine2 'Layer "M-DUCT-INSL")
(vlax-put InsulLine2 'Linetype "BYLAYER")
)
)
(if (or (= (strcase DuctInsul) "OUTSIDE")(= (strcase DuctInsul) "BOTH"))
(progn
(vlax-put InsulLine3 'Layer "M-DUCT-INSL")
(vlax-put InsulLine3 'Linetype "BYLAYER")
(vlax-put InsulLine4 'Layer "M-DUCT-INSL")
(vlax-put InsulLine4 'Linetype "BYLAYER")
)
)
(DUCT_TEXT)
)
;;; ------------ TEXT CREATION SUB ROUTINE
(defun DUCT_TEXT (/)

(if(= (strcase DuctStyle) "SQUARE")
(setq DuctSize (strcat (rtos DuctWidth 5 2) "\" x " (rtos DuctHeight 5 2)"\""))
(setq DuctSize (strcat "ø"(rtos DuctWidth 5 2) "\"" ))
)

;; Setup layer
(DUCT_CREATE_LAYER "M-HVAC-IDEN" "Duct size and pressure classes" "Continuous" "35" "6" "1")

;; Setup text entity list
(setq TextEntList
(list
'(0 . "TEXT") ;***
(cons 1 DuctSize) ;*** Text String
'(6 . "BYLAYER") ;*** Linetype
'(7 . "STANDARD") ;*** Text Style
'(8 . "M-HVAC-IDEN") ;*** Layer Name
(cons 10 (polar Midpoint1 (- DuctAngle (DUCT_DTR 180))6)) ;*** Start Point
(cons 11 Midpoint1) ;*** End Point
'(39 . 0.0)
'(40 . 6.0) ;*** Height
'(41 . 1.0)
(cons 50 DuctAngle) ;*** Text rotation angle
'(51 . 0.0)
'(62 . 256)
'(71 . 0)
'(72 . 1)
'(73 . 2)
)
)
(entmake TextEntList)

;; Reset Rnvironment
(DUCT_RESET_ENV)

)
;;; ------------ DEGREES TO RADIANS SUB ROUTINE
(defun DUCT_DTR (NumberOfDegrees)
(* pi (/ NumberOfDegrees 180.0))
)
;;; ------------ RESET SYSEM VARIABLES
(defun DUCT_RESET_ENV (/)

(setvar "CMDECHO" OldCmdEcho)
(setvar "CLAYER" OldClayer)
(princ)
)
;;;
;;; Echos to the command line
(princ "\n CreateDuct v1.0 ©Timothy Spangler, \n  November, 2006....loaded.")
(terpri)
(princ "C:DUCT")
(print)
;;; End echo
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016

Andrea

  • Water Moccasin
  • Posts: 2372
Re: Prog - Double line flexduct
« Reply #2 on: November 15, 2006, 05:48:56 PM »
Hi TIM..

Nice code...;-)

i have wrote this few year ago..
Code: [Select]
;CONDUIT FLEXIBLE
;par ANDREA ANDREETTI 2004 11 30

(defun dtr (a)
   (* pi (/ a 180.0))
)


;-------------------------------
(defun C:FLEX (/ ort lup col cel dif ddi pt1 pt2 len len1 pangle luc)
     
      (graphscr)
     (setq ort (getvar "orthomode" )
   lup (getvar "luprec")
     luc (setvar "luprec" 0)
   col (getvar "cecolor")
           cel (getvar "celtype")
           dif (getreal (strcat "\nFlexible dimension <" (rtos (getvar "plinewid")) ">: "))
   ddi (if (< dif 4) (setq dif nil))
   pt1 (getpoint "Flexible duct start: ")
   pt2 (getpoint pt1"")
   len (getvar "Textsize" )
           len1(/ (getvar "textsize") 3)
           pangle (angle pt1 pt2)   
           luc (setvar "luprec" lup)
)

 
(command "orthomode" "0")
(command "pdmode" "0")
(command "pdsize" "0")
  (if (not (tblsearch "ltype" "flex"))
    (progn
      (setvar "filedia" 0)
      (command "_.-linetype" "_l" "flex" "mec.lin" ""))
    (setvar "filedia" 1)
    )

    (command "celtype" "flex" "plinewid" dif "cecolor" "13" "._pline" pt1 (polar pt1 pangle len1 ) "a")
    (setvar "cecolor" col)(princ)
    (setvar "celtype" cel)(princ)
    (setvar "orthomode" ort)(princ)
)

(princ "\n\n


 |=======================================================|
 |       Flexduct ver. 2.1 -- by Andrea Andreetti        |
 |            write --> FLEX <-- to begin                |
 |                                                       |
 |=======================================================|")                                   

                    (princ)



;;flex linetype in MEL.LIN
;;*FLEX,Flex  |  |  |  |  |  |  |  |  |  |  |  |  |  |
;;A,0,-.375

You can also take a look here..
« Last Edit: November 15, 2006, 05:51:04 PM by Andrea »
Keep smile...

hudster

  • Gator
  • Posts: 2848
Re: Prog - Double line flexduct
« Reply #3 on: November 16, 2006, 03:31:31 AM »
For any UK based consultants or Contractors, have a look at CAD duct, it's a freebie HVAC program from Lindab, draws your ducts in 3D with an option to create a 2d slice through the drawing if you wish to issue in 2D format.

It's for 2006 only, they haven't caught up with 2007 yet, but it's very powerful, you can quickly run up a vent layout, quicker than single line.

Here is a png of a layout i'm working on.
Revit BDS 2017, 2016, 2015, 2014, AutoCAD 2017, 2016, Navisworks 2017, 2016, BIM360 Glue

Andrea

  • Water Moccasin
  • Posts: 2372
Re: Prog - Double line flexduct
« Reply #4 on: November 16, 2006, 10:25:02 AM »
Hi Andy,...

seem nice...
could you provide screenshot of 2D part ? just to see..
and what is the price of this software ?
Keep smile...

hudster

  • Gator
  • Posts: 2848
Re: Prog - Double line flexduct
« Reply #5 on: November 16, 2006, 10:50:19 AM »
here is a 2D output from a lower floor, so you can see how it details both circular and rectangular ducts, as well as flexible connections, vcds etc.

It's quite simple to use, enter elevation data, choose supply or extract from the settings menu and begin drawing.

For placing a grille, you enter the neck radius and it's flow rate, then to connect them with a flex, select the grille and it auto connects.

This is not only a draughting tool, by entering the correct information it can also calculate your system to act as a double check.

And the best thing is it doesn't cost a penny, as long as you are a specifier they are quite happy for you to use the system for free, and we regularly specify the manufacturer anyway. www.lindab.co.uk

Revit BDS 2017, 2016, 2015, 2014, AutoCAD 2017, 2016, Navisworks 2017, 2016, BIM360 Glue

Andrea

  • Water Moccasin
  • Posts: 2372
Re: Prog - Double line flexduct
« Reply #6 on: November 20, 2006, 10:43:43 AM »
Andy,...

i'm trying to get the software..
but i can'T...

many e-mail sent.....but no answer..

where did you get it ?
Keep smile...

hudster

  • Gator
  • Posts: 2848
Re: Prog - Double line flexduct
« Reply #7 on: November 20, 2006, 11:37:01 AM »
You need to contact them, as long as you are UK based they will send you a download link and licence code via email.

This is their website www.lindab.co.uk select the ventelation option, then cadvent demo.
Revit BDS 2017, 2016, 2015, 2014, AutoCAD 2017, 2016, Navisworks 2017, 2016, BIM360 Glue

xyp1964

  • Guest
Re: Prog - Double line flexduct
« Reply #8 on: March 26, 2010, 12:59:07 AM »
Image

cmwade77

  • Swamp Rat
  • Posts: 1443
Re: Prog - Double line flexduct
« Reply #9 on: March 26, 2010, 05:08:03 PM »
Very nice program, but where do I get it?

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Prog - Double line flexduct
« Reply #10 on: March 26, 2010, 11:17:26 PM »
What are the rules for flex duct?
Minimum turning radius: Inside radius of the turn must be at least 2 times the duct diameter.
Take off to turn distance: you may begin the turn at the take off collar.
Number of turns: any limit
Max degrees of turns: Is there a cumulative limit?
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Prog - Double line flexduct
« Reply #11 on: March 26, 2010, 11:40:49 PM »
What are the rules for flex duct?
Minimum turning radius: Inside radius of the turn must be at least 2 times the duct diameter.
Take off to turn distance: you may begin the turn at the take off collar.
Number of turns: any limit
Max degrees of turns: Is there a cumulative limit?

Something we don't see often enough here
Quote
What are the rules ?
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.