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