;;; ------------------------------------------------------------------------
;;; CreateWye.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:WYE (/)(WYE_START))
;;; ------------ MAIN FUNCTION
(defun WYE_START (/ *error* ActiveDoc Space OldClayer OldCmdEcho OldOsmode LineStart LineEnd
LineAngle TrunkSize WyeStart SidePoint TrunkDirection 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)
)
(WYE_RESET_ENV)
(princ)
)
;;; End Error Handler ---------------------------------------------------
(WYE_SET_ENV)
)
;;; ------------ SET ENVIROMENT BEFORE LAUNCH
(defun WYE_SET_ENV(/)

(setq OldClayer (getvar "CLAYER"))
(setq OldCmdEcho (getvar "CMDECHO"))
(setq OldOsmode (getvar "OSMODE"))
(setq OldCeColor (getvar "CECOLOR"))

(setvar "CMDECHO" 0)
(command "_undo" "begin")

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

;; Setup layer for centerline
(WYE_CREATE_LAYER "M-HVAC-CNTR" "Mechanical Plan - Ductwork centerline" "CENTER2" "25" "12" "0")
;; Setup layer for insulation
(WYE_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork insulation" "HIDDEN2" "15" "201" "1")

;; Run wye
(WYE_RUN)
)
;;; ------------ RUN WYE SUB ROUTINE - GET VARIABLES
(defun WYE_RUN (/ TrunkLine EntList WyeLayer)

;; Get properties from current trunk line
(while (null (setq TrunkLine (car(nentsel "\n Select trunk to add wye to: "))))
(princ "\n Duct not selected")
)
(setq EntList (entget TrunkLine))
(setq WyeLayer (cdr (assoc 8 EntList)))

;; Set layer
(setvar "CLAYER" WyeLayer)

;; Set wye 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 WyeStart (polar LineStart LineAngle (/ (distance LineStart LineEnd) 2)))
)
(progn
(princ " Trunk must be a line. ")
(WYE_RUN)
)
)

;; Get wye direction
(setq SidePoint (getpoint WyeStart "\n Define wye direction "))
(setq TrunkDirection (WYE_GET_PERP LineStart LineEnd SidePoint))

;; Get wye outlet size
(setq WyeOutlet (- TrunkSize 4.0))
(initget 6)
(if (not(setq WyeOutlet (getreal (strcat "\n Enter wye outlet size: " ""))))
(setq WyeOutlet (- TrunkSize 4.0))
)

;; Get wye insulation
(initget 1 "None Inside Outside Both")
(setq WyeInsul (getkword "\n Insulation options: (None/Inside/Oustside/Both)"))

;; Create wye
(WYE_CREATE WyeInsul)
)
;;; ------------ CREATE WYE SUB ROUTINE
(defun WYE_CREATE (WyeInsul / WyePt01 WyePt02 WyePt03 WyePt04 WyePt05 WyePt06 WyePt07 WyePt08 WyePt09
WyePt10 WyePt11 WyePt12 WyeLine01 WyeLine02 WyeLine03 WyeLine04 WyeLine05 WyeLine06 WyeLine07 WyeLine08
WyeLine09 WyeLine10 WyeLine11 DivAngle DivStart InsLine01 InsLine02 InsLine03 InsLine04 InsLine05
InsLine06 InsLine07 InsLine08 InsLine09 InsLine10 InsLine11 Inter01 Inter02 Inter03 Inter04 Inter05
Inter06 CntrLineRad CntrPt01 CntrPt02 CntrPt03 CntrPt04 CntrPt05 CntrPt06 WyeCntrLine01 WyeCntrLine02
WyeCntrLine03 WyeCntrLine04 WyeCntrLine05 WyeCntrLine06 WyeCntrLine07 WyeCntrLine08 VaneLine01 VaneLine02)

;; Create outside points
(setq WyePt01 (polar WyeStart (WYE_ADD_ANGLE TrunkDirection 90.0)(/ TrunkSize 2.0)))
(setq WyePt02 (polar WyeStart (WYE_SUBTRACT_ANGLE TrunkDirection 90.0)(/ TrunkSize 2.0)))
(setq WyePt03 (polar WyePt01 TrunkDirection 3.0))
(setq WyePt04 (polar WyePt02 TrunkDirection 3.0))
(setq WyePt05 (polar WyePt03 (WYE_ADD_ANGLE TrunkDirection 45.0) 3.0))
(setq WyePt06 (polar WyePt04 (WYE_SUBTRACT_ANGLE TrunkDirection 45.0) 3.0))
(setq WyePt07 (polar WyePt05 (WYE_SUBTRACT_ANGLE TrunkDirection 45.0) WyeOutlet))
(setq WyePt08 (polar WyePt06 (WYE_ADD_ANGLE TrunkDirection 45.0) WyeOutlet))
(setq WyePt09 (polar WyePt07 (WYE_SUBTRACT_ANGLE TrunkDirection 135.0) 3.0))
(setq WyePt10 (polar WyePt08 (WYE_ADD_ANGLE TrunkDirection 135.0) 3.0))
(setq WyePt11
(inters
(list (car WyePt07)(cadr WyePt07))
(list (car WyePt09)(cadr WyePt09))
(list (car WyePt08)(cadr WyePt08))
(list (car WyePt10)(cadr WyePt10))
nil)
)
(setq WyePt11 (list (car WyePt11)(cadr WyePt11) 0.0))
(setq WyePt12 (polar WyeStart TrunkDirection 3.0))

;; Create wye
(setq WyeLine01 (vlax-invoke space 'addline WyePt01 WyePt02))
(setq WyeLine02 (vlax-invoke space 'addline WyePt01 WyePt03))
(setq WyeLine03 (vlax-invoke space 'addline WyePt02 WyePt04))
(setq WyeLine04 (vlax-invoke space 'addline WyePt03 WyePt05))
(setq WyeLine05 (vlax-invoke space 'addline WyePt04 WyePt06))
(setq WyeLine06 (vlax-invoke space 'addline WyePt05 WyePt07))
(setq WyeLine07 (vlax-invoke space 'addline WyePt06 WyePt08))
(setq WyeLine08 (vlax-invoke space 'addline WyePt07 WyePt11))
(setq WyeLine09 (vlax-invoke space 'addline WyePt08 WyePt11))
(setq WyeLine10 (vlax-invoke space 'addline WyePt11 WyePt12))

;;Create divider
(setq DivAngle (+ TrunkDirection (/ pi 4)))
(setq DivStart (polar WyePt12 DivAngle 0.5))
(command "_.arc" DivStart "C" WyePt12 "A" 270)

;; Create inside insulation
(if (or (= WyeInsul "Inside")(= WyeInsul "Both"))
(progn
;; Create insulation
(setq InsLine01 (car (vlax-invoke WyeLine02 'offset -1.0)))
(setq InsLine02 (car (vlax-invoke WyeLine03 'offset 1.0)))
(setq InsLine03 (car (vlax-invoke WyeLine04 'offset -1.0)))
(setq InsLine04 (car (vlax-invoke WyeLine05 'offset 1.0)))
(setq InsLine05 (car (vlax-invoke WyeLine08 'offset -1.0)))
(setq InsLine06 (car (vlax-invoke WyeLine09 'offset 1.0)))
(setq Inter01 (vlax-invoke InsLine01 'intersectwith InsLine03 acExtendBoth))
(setq Inter02 (vlax-invoke InsLine02 'intersectwith InsLine04 acExtendBoth))
(setq Inter03 (vlax-invoke InsLine05 'intersectwith InsLine06 acExtendBoth))
(vlax-put InsLine01 'endpoint Inter01)
(vlax-put InsLine03 'startpoint Inter01)
(vlax-put InsLine02 'endpoint Inter02)
(vlax-put InsLine04 'startpoint Inter02)
(vlax-put InsLine05 'endpoint Inter03)
(vlax-put InsLine06 'endpoint Inter03)

;; Set insulation properties
(vlax-put InsLine01 'Layer "M-HVAC-INSL")
(vlax-put InsLine02 'Layer "M-HVAC-INSL")
(vlax-put InsLine03 'Layer "M-HVAC-INSL")
(vlax-put InsLine04 'Layer "M-HVAC-INSL")
(vlax-put InsLine05 'Layer "M-HVAC-INSL")
(vlax-put InsLine06 'Layer "M-HVAC-INSL")
)
)
;; Create outside insulation
(if (or (= WyeInsul "Outside")(= WyeInsul "Both"))
(progn
;; Create isnulation
(setq InsLine07 (car (vlax-invoke WyeLine02 'offset 1.0)))
(setq InsLine08 (car (vlax-invoke WyeLine03 'offset -1.0)))
(setq InsLine09 (car (vlax-invoke WyeLine04 'offset 1.0)))
(setq InsLine10 (car (vlax-invoke WyeLine05 'offset -1.0)))
(setq InsLine11 (car (vlax-invoke WyeLine08 'offset 1.0)))
(setq InsLine12 (car (vlax-invoke WyeLine09 'offset -1.0)))
(setq Inter04 (vlax-invoke InsLine07 'intersectwith InsLine09 acExtendBoth))
(setq Inter05 (vlax-invoke InsLine08 'intersectwith InsLine10 acExtendBoth))
(setq Inter06 (vlax-invoke InsLine11 'intersectwith InsLine12 acExtendBoth))
(vlax-put InsLine07 'endpoint Inter04)
(vlax-put InsLine09 'startpoint Inter04)
(vlax-put InsLine08 'endpoint Inter05)
(vlax-put InsLine10 'startpoint Inter05)
(vlax-put InsLine11 'endpoint Inter06)
(vlax-put InsLine12 'endpoint Inter06)

;; Set insulation properties
(vlax-put InsLine07 'Layer "M-HVAC-INSL")
(vlax-put InsLine08 'Layer "M-HVAC-INSL")
(vlax-put InsLine09 'Layer "M-HVAC-INSL")
(vlax-put InsLine10 'Layer "M-HVAC-INSL")
(vlax-put InsLine11 'Layer "M-HVAC-INSL")
(vlax-put InsLine12 'Layer "M-HVAC-INSL")
)
)

;; Set centerline layer
(setvar "CLAYER" "M-HVAC-CNTR")

;; Set centerline radius
(setq CntrLineRad (/ TrunkSize 8.0))

;; Create centerline points - right side
(setq CntrPt01 (polar WyePt05 (angle WyePt05 WyePt07) (/ (distance WyePt05 WyePt07) 2.0)))
(setq CntrPt02 (polar CntrPt01 (WYE_ADD_ANGLE (angle WyePt03 WyePt05) 180.0) 2.0))
(setq CntrPt02
(inters
(list (car CntrPt01)(cadr CntrPt01))
(list (car CntrPt02)(cadr CntrPt02))
(list (car WyePt03)(cadr WyePt03))
(list (car WyePt11)(cadr WyePt11))
nil)
)
(setq CntrPt02 (list(car CntrPt02)(cadr CntrPt02) 0.0))
(setq CntrPt03 (polar CntrPt02 (WYE_ADD_ANGLE TrunkDirection 180.0) (* 2 CntrLineRad)))
(setq CntrPt03
(inters
(list (car CntrPt02)(cadr CntrPt02))
(list (car CntrPt03)(cadr CntrPt03))
(list (car WyePt01)(cadr WyePt01))
(list (car WyePt02)(cadr WyePt02))
nil)
)
(setq CntrPt03 (polar CntrPt03 TrunkDirection (* 2 CntrLineRad)))
(setq CntrPt03 (list(car CntrPt03)(cadr CntrPt03) 0.0))

;; Create centerline points - left side
(setq CntrPt04 (polar WyePt06 (angle WyePt06 WyePt08) (/ (distance WyePt06 WyePt08) 2.0)))
(setq CntrPt05 (polar CntrPt04 (WYE_ADD_ANGLE (angle WyePt04 WyePt06) 180.0) 2.0))
(setq CntrPt05
(inters
(list (car CntrPt04)(cadr CntrPt04))
(list (car CntrPt05)(cadr CntrPt05))
(list (car WyePt04)(cadr WyePt04))
(list (car WyePt11)(cadr WyePt11))
nil)
)
(setq CntrPt05 (list(car CntrPt05)(cadr CntrPt05) 0.0))
(setq CntrPt06 (polar CntrPt05 (WYE_ADD_ANGLE TrunkDirection 180.0) (* 2 CntrLineRad)))
(setq CntrPt06
(inters
(list (car CntrPt05)(cadr CntrPt05))
(list (car CntrPt06)(cadr CntrPt06))
(list (car WyePt01)(cadr WyePt01))
(list (car WyePt02)(cadr WyePt02))
nil)
)
(setq CntrPt06 (polar CntrPt06 TrunkDirection (* 2 CntrLineRad)))
(setq CntrPt06 (list(car CntrPt06)(cadr CntrPt06) 0.0))

;; Create centerline - right side
(setq WyeCntrLine01 (vlax-invoke space 'addline CntrPt01 CntrPt02))
(setq WyeCntrLine02 (vlax-invoke space 'addline CntrPt02 CntrPt03))
(setq WyeCntrLine03
(vlax-invoke Space 'addArc
(polar CntrPt03 (WYE_SUBTRACT_ANGLE TrunkDirection 90.0) CntrLineRad)
CntrLineRad
(WYE_ADD_ANGLE TrunkDirection 90.0)
(WYE_ADD_ANGLE TrunkDirection 180.0)
)
)
(setq WyeCntrLine04
(vlax-invoke Space 'addArc
(polar WyeStart (WYE_ADD_ANGLE TrunkDirection 90.0) CntrLineRad)
CntrLineRad
(WYE_ADD_ANGLE TrunkDirection 270.0)
(WYE_ADD_ANGLE TrunkDirection 360.0)
)
)
;; Create centerline - left side
(setq WyeCntrLine05 (vlax-invoke space 'addline CntrPt04 CntrPt05))
(setq WyeCntrLine06 (vlax-invoke space 'addline CntrPt05 CntrPt06))
(setq WyeCntrLine07
(vlax-invoke Space 'addArc
(polar CntrPt06 (WYE_ADD_ANGLE TrunkDirection 90.0) CntrLineRad)
CntrLineRad
(WYE_SUBTRACT_ANGLE TrunkDirection 180.0)
(WYE_SUBTRACT_ANGLE TrunkDirection 90.0)
)
)
(setq WyeCntrLine08
(vlax-invoke Space 'addArc
(polar WyeStart (WYE_SUBTRACT_ANGLE TrunkDirection 90.0) CntrLineRad)
CntrLineRad
TrunkDirection
(WYE_ADD_ANGLE TrunkDirection 90.0)
)
)

;; Set vane properties
(setvar "CLAYER" WyeLayer)
(setvar "CECOLOR" "9")

;; Create vane block
(WYE_CREATE_VANE)

;; Create vanes
(setq VaneLine01 (vlax-invoke space 'addline WyePt11 WyePt03))
(setq VaneLine02 (vlax-invoke space 'addline WyePt11 WyePt04))

;; Add "vane" to wye
(command "_divide" (vlax-vla-object->ename VaneLine01) "block" BlockName "y" 3)
(command "_divide" (vlax-vla-object->ename VaneLine02) "block" BlockName "y" 3)

;; Reset environment
(WYE_RESET_ENV)

)
;;; ------------ CREATE VANE BLOCK SUB - DOES NOT INSERT BLOCK
(defun WYE_CREATE_VANE (/ OldLunits OldLuPrec)

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

(setq BlockName "VANE")

(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 "ARC")
(cons 10 (list 2.0 0.0 0.0))
(cons 40 2.0)
(cons 50 2.74889)
(cons 51 3.53429)
(cons 8 "0")
(cons 62 9)
)
)
(entmake
'((0 . "ENDBLK"))
)
)
)
(setvar "LUNITS" OldLunits)
(setvar "LUPREC" OldLuPrec)
BlockName
)
;;; ------------ LAYER CREATION ROUINE
(defun WYE_CREATE_LAYER (Layer Descpition Linetype Thickness Color Plot / Linetype TmpList VLA-Obj)

;; Check to see if linetype exsists
(if (= (tblsearch "ltype" Linetype) nil)
(if (WYE_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 WYE_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(WYE_STRING_TO_LIST CurrentLine ","))2))
(if (= (strcase Linetype) LinetypeName)
(setq Result T)
)
)
)
)
(close OpenFile)
Result
)
;;; ------------ STRING TO LIST SUB ROUTINE
(defun WYE_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))
)
;;; ------------ ADD / SUBTRACT ANGLE SUB ROUTINES
(defun WYE_ADD_ANGLE (Radians AddAngle / )

(WYE_DTR(+ (WYE_RTD Radians) AddAngle))
)
(defun WYE_SUBTRACT_ANGLE (Radians AddAngle / )

(WYE_DTR(- (WYE_RTD Radians) AddAngle))
)

;;; ------------ GET PERPENDICULAR POINT
(defun WYE_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
)
;;; ------------ ROUND NUMBER
(defun WYE_RND (Number Precision)
(setq Number(distof (rtos Number 4 Precision)4))
)
;; ------------ DEGREES / RADIANS SUB ROUTINES
(defun WYE_DTR (NumberOfDegrees)
(* pi (/ NumberOfDegrees 180.0))
)
(defun WYE_RTD (NumberOfRadians)
(* 180.0 (/ NumberOfRadians pi))
)
;;; ------------ RESET SYSEM VARIABLES
(defun WYE_RESET_ENV (/)

(setvar "CMDECHO" OldCmdEcho)
(setvar "CLAYER" OldClayer)
(setvar "OSMODE" OldOsmode)
(setvar "CECOLOR" OldCeColor)
(command "_undo" "end")
(princ)
)
;;;
;;; Echos to the command line
(princ "\n CreateWye v1.1 ©Timothy Spangler, \n January, 2007....loaded.")
(terpri)
(princ "C:WYE")
(print)
;;; End echo

Advertisements