;;; ------------------------------------------------------------------------
;;; CreateDuct.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:DUCT (/) (DUCT_START))

;;; ------------ MAIN FUNCTION
(defun DUCT_START ( / *error* ActiveDoc DuctCond DuctType DuctAgnle DuctHeight DuctWidth DuctLength DuctStyle DuctLayer OldClayer OldCmdEcho MidPoint1 Space StartPoint1 StartPoint2)

;;; 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 ( DuctAngle (DUCT_DTR 90.0))(< DuctAngle (DUCT_DTR 270.0)))
(setq TextAngle (DUCT_ADD_ANGLE DuctAngle 180.0))
(setq TextAngle DuctAngle)
)

;; Create textstyle
(if (not (tblsearch "STYLE" "Archquik"))
(progn
(setq VLTextStyle (vla-Add (vla-Get-Textstyles ActiveDoc) "Archquik"))
(vlax-put VLTextStyle 'FontFile "Archquik")
(vlax-release-object VLTextStyle)
(vlax-release-object ActiveDoc)
(vlax-release-object Space)
)
)
;; Setup text entity list
(setq TextEntList
(list
'(0 . "TEXT") ;***
(cons 1 DuctSize) ;*** Text String
'(6 . "BYLAYER") ;*** Linetype
'(7 . "Archquik") ;*** 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 TextAngle) ;*** Text rotation angle
'(51 . 0.0)
'(62 . 256)
'(71 . 0)
'(72 . 1)
'(73 . 2)
)
)
(entmake TextEntList)

;; Reset Rnvironment
(DUCT_RESET_ENV)

)
;;; ------------ LAYER CREATION ROUINE
(defun DUCT_CREATE_LAYER (Layer Descpition Linetype Thickness Color Plot / TmpList VLA-Obj)

;; 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
(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)
(vlax-release-object VLA-Obj)
)
)
)
;;; ------------ 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(DUCT_STRING_TO_LIST CurrentLine ","))2))
(if (= (strcase Linetype) LinetypeName)
(setq Result T)
)
)
)
)
(close OpenFile)
Result
)
;;; ------------ STRING TO LIST SUB ROUTINE
(defun DUCT_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))
)
;;; ------------ GET PERPENDICULAR POINT
(defun DUCT_GET_PERP (StartPoint EndPoint Point / EntList LineStart LineEnd LineAngle 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
)
;;; ------------ ADD / SUBTRACT ANGLE SUB ROUTINES
(defun DUCT_ADD_ANGLE (Radians AddAngle / )

(DUCT_DTR(+ (DUCT_RTD Radians) AddAngle))
)
(defun DUCT_SUBTRACT_ANGLE (Radians AddAngle / )

(DUCT_DTR(- (DUCT_RTD Radians) AddAngle))
)
;; ------------ DEGREES / RADIANS SUB ROUTINES
(defun DUCT_DTR (NumberOfDegrees)
(* pi (/ NumberOfDegrees 180.0))
)
(defun DUCT_RTD (NumberOfRadians)
(* 180.0 (/ NumberOfRadians pi))
)
;;; ------------ SET ENVIROMENT BEFORE LAUNCH
(defun DUCT_SET_ENV(/)

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

(setvar "CMDECHO" 0)
(setvar "ORTHOMODE" 1)

(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)
)
)
;; Create needed layers
(DUCT_CREATE_LAYER "M-HVAC-SUPP" "Mechanical Plan - Supply ductwork" "Continuous" "35" "133" "1")
(DUCT_CREATE_LAYER "M-HVAC-RETN" "Mechanical Plan - Return ductwork" "Continuous" "35" "23" "1")
(DUCT_CREATE_LAYER "M-HVAC-EXHS" "Mechanical Plan - Exhaust ductwork" "Continuous" "35" "83" "1")
(DUCT_CREATE_LAYER "M-HVAC-DUST" "Mechanical Plan - Dust and fume collection ductwork" "Continuous" "35" "203" "1")
(DUCT_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")
(DUCT_CREATE_LAYER "M-HVAC-IDEN" "Mechanical Plan - Duct size and pressure classes" "Continuous" "25" "2" "1")
(DUCT_CREATE_LAYER "M-HVAC-CNTR" "Mechanical Plan - Ductwork centerline" "CENTER2" "25" "12" "0")

;; Run duct
(DUCT_RUN)
)
;;; ------------ RESET SYSEM VARIABLES
(defun DUCT_RESET_ENV (/)

(setvar "CMDECHO" OldCmdEcho)
(setvar "CLAYER" OldClayer)
(setvar "ORTHOMODE" OldOrthoMode)
(princ)
)
;;;
;;; Echos to the command line
(princ "\n CreateDuct v1.1 ©Timothy Spangler, \n January, 2007....loaded.")
(terpri)
(princ "C:DUCT")
(print)
;;; End echo

Advertisements