Jump to content

double line flex lisp


meecpc

Recommended Posts

Hi all,

First timer here so please be patient.

I am looking for a lisp the will draw 2d flexible duct. Does this monster exist?

 

Bill

Link to comment
Share on other sites

  • Replies 57
  • Created
  • Last Reply

Top Posters In This Topic

  • TimSpangler

    15

  • meecpc

    9

  • CAB

    4

  • d_kinneyjr

    2

Top Posters In This Topic

Posted Images

Sure it does! Here is one that I wrote as part of a HVAC 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

 

 

It will need to be modified to suite your needs. I usually select a trunk line. From that it gets the size and layer of the flex. If you need I can mod it to suite your needs.

Link to comment
Share on other sites

Tim,

When I type Flex at the command line I get the error message,

 

*** Program Error: BAD ARGUMENT TYPE: STRINGP NIL ***

 

What am I doing wrong?

 

Bill

Link to comment
Share on other sites

Here is another lisp to try:

 

;;;=======================[ 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

Flex 17 CAB.LSP

Flex01.png

Link to comment
Share on other sites

Try this one. I removed everything and made it standalone

 

;;; ------------------------------------------------------------------------
;;;    CreateFlex.lsp v1.2
;;;
;;;    Copyright © May, 2008
;;;    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 OldFillMode
ActiveDoc Space FlexSize FlexStart TrunkLine 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 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)
 )
)  
;; Run flex duct program
(FLEX_RUN) 
)
;;; ------------ GET USER VARIABLES SUB
(defun FLEX_RUN (/ FlexStart EndPoint FlexSize PlineEnt VLPlineObj VLPlineLength FlexDuct1 FlexDuct2
FlexDuct1Pts FlexDuct2Pts FlexDuct3Pts FlexDuct4Pts FlexCap1 FlexCap2)
(if (not (setq FlexSize (getreal "\n Enter flex size: <6\"> ")))
 (setq FlexSize 6.0)
)
(FLEX_BLOCK FlexSize)

(setq FlexStart (getpoint "\n Define flex start point: "))
(setq FlexEnd (getpoint FlexStart "\n Define flex direction: "))
(setq FlexEnd (polar FlexStart (angle FlexStart FlexEnd) 3.0))

(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))
(setq FlexDuct3Pts (vlax-curve-getStartPoint FlexDuct1))
(setq FlexDuct4Pts (vlax-curve-getStartPoint FlexDuct2))

;; Create caps
(setq FlexCap1 (vlax-invoke space 'addline FlexDuct1Pts FlexDuct2Pts))
(setq FlexCap2 (vlax-invoke space 'addline FlexDuct3Pts FlexDuct4Pts))

(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
)
;;; ------------ RESET SYSEM VARIABLES
(defun FLEX_RESET_ENV (/)
;; Release ActiveX objects
(vlax-release-object ActiveDoc)
(vlax-release-object Space)

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

;; Reset undo marker
(command "undo" "End")

(setvar "CMDECHO" OldCmdEcho)
(princ) 
)
;;;
;;; Echos to the command line
(princ "\n CreateFlex v1.2© \n Timothy Spangler, \n  May, 2008....loaded.")
(terpri)
(princ "C:FLEX")
(print)
;;; End echo
  

 

See if this works any better.

Link to comment
Share on other sites

Tim,

It works now but is there a way to show the flex terminating at a diffuser with a round end? Kinda hard to explain.

Link to comment
Share on other sites

Tim,

Are you still with me? I love this lisp routine, thanks a bunch. Can you make it terminate with a round end?

Link to comment
Share on other sites

Sorry, been a bit busy the last 2 days. Let me get home and give it a shot tonite. I'll post back later this evening.

Link to comment
Share on other sites

Tim,

Glad to hear you're still there. Was getting a bit worried...lol.

Can you remove the centerline as well? This lisp is working great, realy makes the ductwork look real. Thanks again!

Link to comment
Share on other sites

Try this one. I removed everything and made it standalone

 

;;; ------------------------------------------------------------------------
;;;    CreateFlex.lsp v1.2
;;;
;;;    Copyright © May, 2008
;;;    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 OldFillMode
ActiveDoc Space FlexSize FlexStart TrunkLine 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 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)
 )
)  
;; Run flex duct program
(FLEX_RUN) 
)
;;; ------------ GET USER VARIABLES SUB
(defun FLEX_RUN (/ FlexStart EndPoint FlexSize PlineEnt VLPlineObj VLPlineLength FlexDuct1 FlexDuct2
FlexDuct1Pts FlexDuct2Pts FlexDuct3Pts FlexDuct4Pts FlexCap1 FlexCap2)
(if (not (setq FlexSize (getreal "\n Enter flex size: <6\"> ")))
 (setq FlexSize 6.0)
)
(FLEX_BLOCK FlexSize)

(setq FlexStart (getpoint "\n Define flex start point: "))
(setq FlexEnd (getpoint FlexStart "\n Define flex direction: "))
(setq FlexEnd (polar FlexStart (angle FlexStart FlexEnd) 3.0))

(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))
(setq FlexDuct3Pts (vlax-curve-getStartPoint FlexDuct1))
(setq FlexDuct4Pts (vlax-curve-getStartPoint FlexDuct2))

;; Create caps
(setq FlexCap1 (vlax-invoke space 'addline FlexDuct1Pts FlexDuct2Pts))
(setq FlexCap2 (vlax-invoke space 'addline FlexDuct3Pts FlexDuct4Pts))

(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
)
;;; ------------ RESET SYSEM VARIABLES
(defun FLEX_RESET_ENV (/)
;; Release ActiveX objects
(vlax-release-object ActiveDoc)
(vlax-release-object Space)

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

;; Reset undo marker
(command "undo" "End")

(setvar "CMDECHO" OldCmdEcho)
(princ) 
)
;;;
;;; Echos to the command line
(princ "\n CreateFlex v1.2© \n Timothy Spangler, \n  May, 2008....loaded.")
(terpri)
(princ "C:FLEX")
(print)
;;; End echo

 

See if this works any better.

Tim,

 

This is pretty cool tool!

 

Brad

Link to comment
Share on other sites

Here is the follow up. Hopefully this will work for you.

 

;;; ------------------------------------------------------------------------
;;;    CreateFlex.lsp v1.2
;;;
;;;    Copyright © May, 2008
;;;    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 OldFillMode
ActiveDoc Space FlexSize FlexStart TrunkLine 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 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)
 )
)  
;; Run flex duct program
(FLEX_RUN) 
)
;;; ------------ GET USER VARIABLES SUB
(defun FLEX_RUN (/ FlexStart EndPoint FlexSize PlineEnt VLPlineObj VLPlineLength FlexDuct1 FlexDuct2
FlexDuct1Pts FlexDuct2Pts FlexDuct3Pts FlexDuct4Pts FlexCap1 FlexCap2)

(if (not (setq FlexSize (getreal "\n Enter flex size: <6\"> ")))
 (setq FlexSize 6.0)
)
(FLEX_BLOCK FlexSize)

(setq FlexStart (getpoint "\n Define flex start point: "))
(setq FlexEnd (getpoint FlexStart "\n Define flex direction: "))
(setq FlexEnd (polar FlexStart (angle FlexStart FlexEnd) 3.0))

(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))
(setq FlexDuct3Pts (vlax-curve-getStartPoint FlexDuct1))
(setq FlexDuct4Pts (vlax-curve-getStartPoint FlexDuct2))

(setq FlexDuct5Pts (vlax-curve-getEndPoint VLPlineObj))

;; Create caps
(setq FlexCap2 (vlax-invoke space 'addline FlexDuct3Pts FlexDuct4Pts))

(vlax-invoke space 
'addarc 
 FlexDuct5Pts 
 (/ FlexSize 2)
 (angle FlexDuct2Pts FlexDuct1Pts)
 (angle FlexDuct1Pts FlexDuct2Pts)
)
(vla-delete VLPlineObj)

(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
)
;;; ------------ RESET SYSEM VARIABLES
(defun FLEX_RESET_ENV (/)
;; Release ActiveX objects
(vlax-release-object ActiveDoc)
(vlax-release-object Space)

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

;; Reset undo marker
(command "undo" "End")

(setvar "CMDECHO" OldCmdEcho)
(princ) 
)
;;;
;;; Echos to the command line
(princ "\n CreateFlex v1.2© \n Timothy Spangler, \n  May, 2008....loaded.")
(terpri)
(princ "C:FLEX")
(print)
;;; End echo

Link to comment
Share on other sites

Tim,

That is the cats ass!!!!!!!

You are the lisp king!!!!!

All hail Tim!!!!!

Thanks a bunch, If there is anything I can do let me know.

 

Your humble servant

Bill

Link to comment
Share on other sites

Tim,

Shal I begin the groveling now?

I was wondering if you can take the latest lisp you sent and chande it to terminate in a straight end like it did before? I need to termination types for different diffuser connections. The lisp you created and modified for me is the BEST addition we have made to our drawing standards. We are signing your praises daily.

 

Forever in your debt

Bill

Link to comment
Share on other sites

How about the option the choose the endcap?

 

;;; ------------------------------------------------------------------------
;;;    CreateFlex.lsp v1.2
;;;
;;;    Copyright © May, 2008
;;;    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 OldFillMode
ActiveDoc Space FlexSize FlexStart TrunkLine 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 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)
 )
)  
;; Run flex duct program
(FLEX_RUN) 
)
;;; ------------ GET USER VARIABLES SUB
(defun FLEX_RUN (/ FlexStart EndPoint FlexSize PlineEnt VLPlineObj VLPlineLength FlexDuct1 FlexDuct2
FlexDuct1Pts FlexDuct2Pts FlexDuct3Pts FlexDuct4Pts FlexDuct5Pts FlexCap1 FlexCap2 CloseOpt)

(if (not (setq FlexSize (getreal "\n Enter flex size: <6\"> ")))
 (setq FlexSize 6.0)
)
(FLEX_BLOCK FlexSize)

(setq FlexStart (getpoint "\n Define flex start point: "))
(setq FlexEnd (getpoint FlexStart "\n Define flex direction: "))
(setq FlexEnd (polar FlexStart (angle FlexStart FlexEnd) 3.0))

(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))
(setq FlexDuct3Pts (vlax-curve-getStartPoint FlexDuct1))
(setq FlexDuct4Pts (vlax-curve-getStartPoint FlexDuct2))

(setq FlexDuct5Pts (vlax-curve-getEndPoint VLPlineObj))

;; Create caps
(setq FlexCap2 (vlax-invoke space 'addline FlexDuct3Pts FlexDuct4Pts))

;; Check for losing option
(initget 1 "Blunt Arched")
(setq CloseOpt (getkword "\n Enter end condition: (Arched/Blunt)"))

(if (= "Blunt" CloseOpt)
 (setq FlexCap1 (vlax-invoke space 'addline FlexDuct1Pts FlexDuct2Pts))
 (progn
  (vlax-invoke space 
  'addarc 
   FlexDuct5Pts 
   (/ FlexSize 2)
   (angle FlexDuct2Pts FlexDuct1Pts)
   (angle FlexDuct1Pts FlexDuct2Pts)
  )
 )
)
;; Delete centerline
(vla-delete VLPlineObj)

(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
)
;;; ------------ RESET SYSEM VARIABLES
(defun FLEX_RESET_ENV (/)
;; Release ActiveX objects
(vlax-release-object ActiveDoc)
(vlax-release-object Space)

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

;; Reset undo marker
(command "undo" "End")

(setvar "CMDECHO" OldCmdEcho)
(princ) 
)
;;;
;;; Echos to the command line
(princ "\n CreateFlex v1.2© \n Timothy Spangler, \n  May, 2008....loaded.")
(terpri)
(princ "C:FLEX")
(print)
;;; End echo

Link to comment
Share on other sites

Tim,

I get this error message then the flex terminates straight.

"Command:

FLEXT

Enter flex size:

Define flex start point:

Define flex direction:

*** Program Error: NO FUNCTION DEFINITION: FLEX_RESET_ENV ***; error: An error

has occurred inside the *error* functionno function definition: FLEX_RESET_ENV

Link to comment
Share on other sites

Tim,

My bad. Had one too many flex.lsp routines loading. Works awesome!!!!

I will devote my life to shouting your name from the highest peaks of the forums!

 

Bill

Link to comment
Share on other sites

Glad to hear you got it. I was going to suggest re-copying the code to make sure you didn't miss a ( or a ) . It'll get ya everytime. :shock:

Link to comment
Share on other sites

  • 2 months later...

Tim-

I have seen your lisp routine for the double line flex. It works well for me and I like it a lot. Is there anyway you can modify the outer lines to be a zig-zag linetype instead of the curved lines? Kind of hard to explain, but hopefully you get the picture. Thanks alot - Dave

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...