;;; ------------------------------------------------------------------------
;;; CreateFlexConn.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:FLEXCONN (/)(FLEX_CONN_START))

;;; ------------ MAIN FUNCTION
(defun FLEX_CONN_START (/
*error*
OldCmdEcho
OldOrthoMode
OldOsmode
OldLunits
OldLunits
OldClayer
OldFillMode
ActiveDoc
Space
ConnSize
TrunkLine
EntList
EntLayer
StartPoint
ExtenLength
LineStart
LineEnd
LineAngle
NewAngle
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 (vla-object (cdr(assoc -1 PlineEnt))))
(setq VLPlineLength (fix(vlax-get VLPlineObj 'length)))

;; Add "flex" to duct
(command "divide" (entlast) "block" BlockName "y" (* 2 VLPlineLength))

;; Create flex duct sides
(setq FlexConn1 (car (vlax-invoke VLPlineObj 'offset (/ ConnSize 2))))
(setq FlexConn2 (car (vlax-invoke VLPlineObj 'offset (-(/ ConnSize 2)ConnSize))))

(vlax-put FlexConn1 'Color 8)
(vlax-put FlexConn2 'Color 8)

(vlax-invoke VLPlineObj 'delete)

;; Setup layer for centerline
(FLEX_CONN_CREATE_LAYER "M-HVAC-CNTR" "Mechanical Plan - Ductwork centerline" "CENTER2" "25" "12" "0")

;; Set properties for centerline
(vlax-put FlexConnCntr 'Layer "M-HVAC-CNTR")

(FLEX_CONN_RESET_ENV)
)
;;; ------------ CREATE FLEX LINE BLOCK SUB - DOES NOT INSERT BLOCK
(defun FLEX_CONN_CREATE_BLOCK (ConnSize /)

(setq OldLunits (getvar "LUNITS"))
(setq OldLuPrec (getvar "LUPREC"))
(setvar "LUNITS" 2)
(setvar "LUPREC" 1)

(setq BlockName (strcat "FLEX-" (rtos ConnSize 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 (- (/ ConnSize 2) ConnSize) 0.0))
(cons 11 (list 0.0 (/ ConnSize 2) 0.0))
(cons 8 "0")
(cons 62 9)
)
)
(entmake
'((0 . "ENDBLK"))
)
)
)
(setvar "LUNITS" OldLunits)
(setvar "LUPREC" OldLuPrec)
BlockName
)
;;; ------------ LAYER CREATION ROUINE
(defun FLEX_CONN_CREATE_LAYER (Layer Descpition Linetype Thickness Color Plot / TmpList VLA-Obj)

;; Check to see if linetype exsists
(if (= (tblsearch "ltype" Linetype) nil)
(if (FLEX_CONN_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)
(vlax-release-object VLA-Obj)
)
)
)
;;; ------------ CHECKS TO SEE IF A LINETYPE IS AVAILIBLE
(defun FLEX_CONN_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_CONN_DTR (NumberOfDegrees)
(* pi (/ NumberOfDegrees 180.0))
)
(defun FLEX_CONN_RTD (NumberOfRadians)
(* 180.0 (/ NumberOfRadians pi))
)

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

;; Reset system variables
(setvar "CMDECHO" OldCmdEcho)
(setvar "CLAYER" OldClayer)

;; Reset undo marker
(command "undo" "End")
(princ)
)
;;;
;;; Echos to the command line
(princ "\n CreateFlexConnector v1.1 ©Timothy Spangler, \n January, 2007....loaded.")
(terpri)
(princ "C:FLEXCONN")
(print)
;;; End echo

Advertisements