Change Layer Colours for support INR (Israel Native Roads) ctb


(defun c:inr (/ colLst lay col) ; change layer colours siutable for INR
(vl-load-com)

(defun C:ACB ; = All to Color Bylayer
(/ cb ent obj blk subent)
(defun cb () ; = force Color(s) to Bylayer
(setq obj (vlax-ename->vla-object ent))
(vla-put-color obj 256); ByLayer
(if (wcmatch (vla-get-ObjectName obj) "*Dimension,*Leader")
(foreach prop '(DimensionLineColor ExtensionLineColor TextColor)
;; not all such entity types have all 3 properties, but all have at least one
(if (vlax-property-available-p obj prop)
(vlax-put obj prop 256); ByLayer
); if
); foreach
); if
); defun -- cb
;; Top-level entities:
(setq ent (entnext))
(while ent
(cb)
(setq ent (entnext ent))
); while
;; Nested entities in this drawing's Block definitions:
(setq blk (tblnext "block" t))
(while blk
(if (= (logand 20 (cdr (assoc 70 blk))) 0); not an Xref [4] or Xref-dependent [16]
(progn
(setq ent (cdr (assoc -2 blk)))
(while ent
(cb)
(setq ent (entnext ent))
); while
); progn
); if
(setq blk (tblnext "block"))
); while

(princ)
); defun
(c:acb)
(layerstate-save "before-inr-change" nil nil)
(setq colLst '(
(7 . 1)
(14 . 27)
(24 . 27)
(20 . 30)
(22 . 27)
(70 . 102)
(74 . 107)
(72 . 102)
(3 . 102)
(90 . 102)
(92 . 102)
(161 . 160)
(151 . 160)
(154 . 160)
(165 . 162)
(140 . 162)
(142 . 162)
(2 . 1)
(50 . 1)
(55 . 107)
(57 . 107)
(75 . 107)
(40 . 27)
(42 . 27)
(155 . 175)
(156 . 175)
(22 . 27)
(10 . 27)
(211 . 27)
(232 . 27)
(13 . 27)
(12 . 27)
(222 . 190)
(224 . 190)
(226 . 190)
(120 . 230)
(122 . 102)
(60 . 230)
(62 . 230)
(64 . 230)
(8 . 253)
(163 . 162)
(81 . 102)
(82 . 102)
(100 . 102)
(92 . 102)
(60 . 1)
(64 . 102)
(62 . 102)
(66 . 102)
(67 . 102)
(253 . 252)
(254 . 252)
(255 . 252)
(227 . 190)
(130 . 162)
(4 . 160)
))

(vlax-for l (vla-get-layers
(vla-get-activedocument
(vlax-get-acad-object)))
(setq lay (cons l lay)))
(foreach layer lay
(if (setq col (assoc (vla-get-color layer) colLst))
(vla-put-color layer (cdr col))))
(princ))

(defun c:rinr (/) ; restore inr layer colours
(vl-load-com)
(layerstate-restore "before-inr-change" nil nil)
)

Draw Polyline Arrow with predefined arrow width


;;; Draw Arrow with user specified values.
;;; Created by Quest for Peace from here: http://www.cadtutor.net/forum/showthread.php?64876-Lisp-to-draw-an-arrow
;;; Modified by Igal Averbuh 2016 (added option to enter arrowhead width by two points and changed "c" value)

(defun c:ah (/ a b c wid)
(vl-load-com)
(setvar "osmode" 0)
(setvar 'dimasz
(cond ((getdist (strcat "\nSpecify Arrowhead width by 2 points : ")))
((getvar 'dimasz))
)
)
(setvar "osmode" 167)
(setq
a (getpoint "\n\nPick Head of Arrow...\n")
wid (getvar "dimasz")
b (getpoint a "Pick End of Arrow...\n")
c (polar a (angle a b) (/ (distance a b) 10))

; wid (/ (distance a b) 10.0)
)
(vla-setWidth
(vlax-ename->vla-object
(entmakex
(append
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 3)
)
(mapcar
(function (lambda (p) (cons 10 (trans p 1 0))))
(list a c b)
)
)
)
)
0
0.0
wid
)
(princ)
)
(c:ah)

Draw Arc Arrow Leader (c)1997, Yuqun Lian


; Arc Arrow Leader (c)1997, Yuqun Lian
;; Modified by Igal Averbuh 2016
;;(Added option to set arrowhead size by 2 poits on screen and option to save previous arrowhead size)
(defun C:AW (/ GAMA BETA ARFA ARCLENG AWIDTH A MIDANGLE ANG)
;--------input endpoints of arc------------------------
(setq TEMPORTHO (getvar "orthomode"))
(setq
TEMPAUNIT (getvar "aunits")
)
(setvar "cmdecho" 0)
(setq TEMPLT (getvar "celtype"))
(setq
TEMPPLW (getvar "plinewid")
)
(setvar "celtype" "bylayer")
(setvar "orthomode" 0)
(setvar "aunits" 0)
(setq PT1 (getpoint "\nArrow Start Point: "))
(setq
PT2 (getpoint PT1 "\nArrow End Point: ")
)
(command "arc" PT1 "e" PT2 "d" pause)
;-------calculate start angle and radious of the arc-----
(setq GAMA (getvar "lastangle")) ;arc endpoint tan angle
(setq BETA (angle PT1 PT2))
(setq ARFA (- BETA GAMA))
(setq ARCLENG (distance PT1 PT2))
(setq
RADIOUS (/ (* 0.5 ARCLENG) (sin ARFA))
)
(setq TANANGLE (+ ARFA BETA))

;-------calculate the angle that the midpoint of the
; arrow is on the arc------------------------------
(setvar "osmode" 0)
(setvar 'dimasz
(cond ((getdist (strcat "\nSpecify Arrowhead Size by 2 points : ")))
((getvar 'dimasz))
)
)
(setvar "osmode" 167)

(setq ARWLENG (* (getvar "dimasz") 1))
(setq
AWIDTH (/ ARWLENG 3.)
)
(setq SINA (/ (* 0.5 ARWLENG) RADIOUS))
(setq
COSA (sqrt (- 1 (* SINA SINA)))
)
(setq TANA (/ SINA COSA))
(setq A (atan TANA))
(setq MIDANGLE (- TANANGLE A))
(setq
PT3 (polar PT1 MIDANGLE ARWLENG)
) ;arrow end point
(command "erase" "l" "")
;-----draw pline arc and arrow------------------------------
(setq ANG (* 57.2958 (+ 3.14159 GAMA))) ;pline start angle
(setvar "fillmode" 1)
(command
"pline" PT2 "w" "0" "0" "arc" "d" ANG PT1 "l" "w" "0" AWIDTH
PT3 "w" "0" "0" ""
)
(setvar "orthomode" TEMPORTHO)
(setvar "aunits" TEMPAUNIT)
(setvar "celtype" TEMPLT)
(setvar "plinewid" TEMPPLW)
(setvar "cmdecho" 1)
(princ)
) ;end aww
(prompt "\nType AW to draw arc leader")
(princ)
(c:aw)

Delete entities within crossing polygon in user selected layouts


;;; Delete entities within crossing polygon in user selected layouts
;;; Saved from here: https://www.theswamp.org/index.php?topic=51868.msg569096#msg569096

;;; LISP to reload all XREF's,and IMAGE's

(defun c:ra (/)
(vl-load-com)
(setvar "visretain" 1)
(vl-cmdf "_.-xref" "r" "*")
(vl-cmdf "_.-image" "r" "*")
(setvar "visretain" 1)
;(vl-cmdf "_.externalreferences")
(princ)
)

;;; LISP to unload all XREF's,and IMAGE's

(defun c:ua (/)
(vl-load-com)
(vl-cmdf "_.-xref" "u" "*")
(vl-cmdf "_.-image" "u" "*")

;(vl-cmdf "_.externalreferences")
(princ)
)
(defun c:dw1 (/ p1 p2 ss)

(vl-load-com)
;; http://www.lee-mac.com/listbox.html
;; List Box - Lee Mac
;; Displays a DCL list box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; bit - [int] 1=allow multiple; 2=return indexes
;; Returns: [lst] List of selected items/indexes, else nil

(defun LM:listbox (msg lst bit / dch des tmp rtn)
(cond
((not
(and
(setq tmp (vl-filename-mktemp nil nil ".dcl"))
(setq des (open tmp "w"))
(write-line
(strcat "listbox:dialog{label=\""
msg
"\";spacer;:list_box{key=\"list\";multiple_select="
(if (= 1 (logand 1 bit))
"true"
"false"
)
";width=50;height=15;}spacer;ok_cancel;}"
)
des
)
(not (close des))
(< 0 (setq dch (load_dialog tmp)))
(new_dialog "listbox" dch)
)
)
(prompt "\nError Loading List Box Dialog.")
)
(t
(start_list "list")
(foreach itm lst (add_list itm))
(end_list)
(setq rtn (set_tile "list" "0"))
(action_tile "list" "(setq rtn $value)")
(setq rtn
(if (= 1 (start_dialog))
(if (= 2 (logand 2 bit))
(read (strcat "(" rtn ")"))
(mapcar '(lambda (x) (nth x lst)) (read (strcat "(" rtn ")")))
)
)
)
)
)
(if (< 0 dch)
(unload_dialog dch)
)
(if (and tmp (setq tmp (findfile tmp)))
(vl-file-delete tmp)
)
rtn
)

(setq layouts (LM:listbox "Select Layouts to Delete from... " (layoutlist) 1))

(vl-load-com)
(if (and (= 0 (getvar 'tilemode))
(setq p1 (getpoint "\nSpecify first corner point: "))
(setq p2 (getcorner p1 "\nSpecify other corner point: "))
)
(foreach tab layouts
(setvar 'ctab tab)
(and (= 1 (getvar 'cvport)) (vlax-invoke (vlax-get-acad-object) 'zoomwindow p1 p2))
(if (setq ss (ssget "C" p1 p2 (list (cons 410 tab))))
(mapcar 'entdel (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
)
)
)
(princ)
)
(defun c:dw (/)
(c:ua)
(c:dw1)
(c:ra)
)
(c:dw)

Replace text, mtext, dim or attribute to PLOT filename of current Layout

;; Replace text, mtext, dim or attribute to PLOT filename
;; Based on pony.chubby routine 2016
;; Saved from here: http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/replace-text-to-filename-problem/td-p/6512932
;; Modified by Igal Averbuh 2016

(defun c:plc ()
(setq layt (getvar 'ctab))
(setq aa (strcat (vl-filename-base (getvar 'DwgName)) ".dwg"))
(setq bb (strcat (vl-filename-base (getvar 'DwgName)) "-" layt ".plt"))
(while (setq txt (car (nentsel "\n Select text, mtext, dim or attribute to replace to plot filename: ")))
(setq vla_obj (vlax-ename->vla-object txt))
(vla-put-textstring vla_obj bb)
)
;(vla-regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports)
)

Replace text, mtext, dim or attribute to filename of current drawing

;; Replace text, mtext, dim or attribute to filename
;; Created by pony.chubby 2016
;; Saved from here: http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/replace-text-to-filename-problem/td-p/6512932

(defun c:flc ()
(setq aa (strcat (vl-filename-base (getvar 'DwgName)) ".dwg"))
(while (setq txt (car (nentsel "\n Select text, mtext, dim or attribute to replace to filename: ")))
(setq vla_obj (vlax-ename->vla-object txt))
(vla-put-textstring vla_obj aa)
)
(vla-regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports)
)

HVAC Wye Creator


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

HVAC Turndown Creator


;Tip1734: TDN.LSP Ductwork turndown (c)2001, Paul Bilodeau

(defun C:TDN ()
(setvar "cmdecho" 0)
(setq COSMODE (getvar "osmode"))
(setq CLY (getvar "CLAYER"))
(setvar "osmode" 0)
(setvar "osmode" 1)
(setq CPT (getpoint "\nPick ENDPOINT of Line: "))
(setq LNENT (nentselp CPT))
(setvar "osmode" 0)
(setq LNDATA (entget (car LNENT)))
(setq C10 (cdr (assoc 10 LNDATA)))
(setq C11 (cdr (assoc 11 LNDATA)))
(if (equal C10 CPT)
(setq ANG (angle CPT C11))
(setq ANG (angle CPT C10))
)
(if (equal ARAD NIL)
(setq CRAD 0)
(setq CRAD ARAD))
(initget 6)
(setq ARAD (getreal (strcat
"\nRadius of Turndown: : ")))
(if (= ARAD NIL)
(setq ARAD CRAD))
(setq STANG (+ ANG (/ pi 4)))
(setq APT1 (polar CPT STANG ARAD))
(setvar "CLAYER" (cdr (assoc 8 LNDATA)))
(command "_.arc" APT1 "C" CPT "A" 270)
(setvar "osmode" COSMODE)
(setvar "CLAYER" CLY)
(princ)
) ;ends defun

HVAC Transition Creator


;;; ------------------------------------------------------------------------
;;; CreateTransition.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:TRANS (/) (TRANS_START))

;;; ------------ MAIN FUNCTION
(defun TRANS_START ( / *error* ActiveDoc Space OldClayer OldCmdEcho TrunkLine EntList
LineStart LineEnd LineAngle TrunkSize TransStart TrunkDirection TransOutSize TransLength
TransStyle TransInsul )

;;; 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 (Rnd/Rnd->Sq)"))

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

;; Create transition type
(cond
((= (strcase TransStyle) "SQUARE")
(TRANS_SQ->TRANS_RND TrunkSize TransOutSize TransStart TransLayer TransInsul)
)
((= (strcase TransStyle) "ROUND")
(TRANS_RND->SQ TrunkSize TransOutSize TransStart TransLayer TransInsul)
)
)
)
;;; ------------ SQUARE TO ROUND TRANSITION
(defun TRANS_SQ->TRANS_RND (TrunkSize TransOutSize TransStart TransLayer TransInsul / TransCntr TransBreaks
TransInsPoint01 TransInsPoint02 TransInsPoint03 TransInsPoint04 TransInsPoint05 TransInsPoint06
TransInsPoint01 TransInsPoint02 TransInsPoint03 TransInsPoint04 TransInsPoint05 TransInsPoint06
TransInsPoint07 TransInsPoint08)

;; Get transition outer points
(setq TransCntr (polar TransStart TrunkDirection TransLength))

(setq TransPoint01 (polar TransStart (TRANS_ADD_ANGLE TrunkDirection 90.0) (* 0.5 TrunkSize)))
(setq TransPoint02 (polar TransStart (TRANS_SUBTRACT_ANGLE TrunkDirection 90.0) (* 0.5 TrunkSize)))
(setq TransPoint03 (polar TransCntr (TRANS_ADD_ANGLE TrunkDirection 90.0) (* 0.5 TransOutSize)))
(setq TransPoint04 (polar TransCntr (TRANS_SUBTRACT_ANGLE TrunkDirection 90.0) (* 0.5 TransOutSize)))

;; Get transition inner point (curves for round outlet)
(setq TransBreaks (* 0.25 TransOutSize))
(setq TransPoint05 (polar TransCntr (TRANS_ADD_ANGLE TrunkDirection 90.0) TransBreaks))
(setq TransPoint06 (polar TransCntr (TRANS_SUBTRACT_ANGLE TrunkDirection 90.0) TransBreaks))

;; Get Insulation Points - INSIDE
(setq TransInsPoint01 (polar TransStart (TRANS_ADD_ANGLE TrunkDirection 90.0) (- 1.0 (* 0.5 TrunkSize))))
(setq TransInsPoint02 (polar TransStart (TRANS_SUBTRACT_ANGLE TrunkDirection 90.0) (- 1.0 (* 0.5 TrunkSize))))
(setq TransInsPoint03 (polar TransCntr (TRANS_ADD_ANGLE TrunkDirection 90.0) (- 1.0 (* 0.5 TransOutSize))))
(setq TransInsPoint04 (polar TransCntr (TRANS_SUBTRACT_ANGLE TrunkDirection 90.0) (- 1.0 (* 0.5 TransOutSize))))
;; Get Insulation Points - OUTSIDE
(setq TransInsPoint05 (polar TransStart (TRANS_ADD_ANGLE TrunkDirection 90.0) (+ 1.0 (* 0.5 TrunkSize))))
(setq TransInsPoint06 (polar TransStart (TRANS_SUBTRACT_ANGLE TrunkDirection 90.0) (+ 1.0 (* 0.5 TrunkSize))))
(setq TransInsPoint07 (polar TransCntr (TRANS_ADD_ANGLE TrunkDirection 90.0) (+ 1.0 (* 0.5 TransOutSize))))
(setq TransInsPoint08 (polar TransCntr (TRANS_SUBTRACT_ANGLE TrunkDirection 90.0) (+ 1.0 (* 0.5 TransOutSize))))

;; Draw Transition
(vlax-invoke space 'addline TransPoint01 TransPoint02)
(vlax-invoke space 'addline TransPoint02 TransPoint04)
(vlax-invoke space 'addline TransPoint04 TransPoint03)
(vlax-invoke space 'addline TransPoint03 TransPoint01)

;; Change layer color
(setvar "CECOLOR" "8")

;; Draw Transition Breaks
(vlax-invoke space 'addline TransPoint01 TransPoint05)
(vlax-invoke space 'addline TransPoint02 TransPoint06)
(vlax-invoke space 'addline TransPoint01 TransCntr)
(vlax-invoke space 'addline TransPoint02 TransCntr)

;; Set Center Line properties
(setvar "CLAYER" "M-HVAC-CNTR")
(setvar "CECOLOR" "BYLAYER")

;; Draw Centerline
(vlax-invoke space 'addline TransStart TransCntr)

;; Set Insulation Line properties
(setvar "CLAYER" "M-HVAC-INSL")

;; Draw Insulation
(if (= (strcase TransInsul) "INSIDE")
(progn
(vlax-invoke space 'addline TransInsPoint01 TransInsPoint03)
(vlax-invoke space 'addline TransInsPoint02 TransInsPoint04)
)
)
(if (= (strcase TransInsul) "OUTSIDE")
(progn
(vlax-invoke space 'addline TransInsPoint05 TransInsPoint07)
(vlax-invoke space 'addline TransInsPoint06 TransInsPoint08)
)
)
(if (= (strcase TransInsul) "BOTH")
(progn
(vlax-invoke space 'addline TransInsPoint01 TransInsPoint03)
(vlax-invoke space 'addline TransInsPoint02 TransInsPoint04)
(vlax-invoke space 'addline TransInsPoint05 TransInsPoint07)
(vlax-invoke space 'addline TransInsPoint06 TransInsPoint08)
)
)
(TRANS_RESET_ENV)
)
;;; ------------ SQUARE TO SQUARE TRANSITION
(defun TRANS_RND->SQ (TrunkSize TransOutSize TransStart TransLayer TransInsul /
TransInsPoint01 TransInsPoint02 TransInsPoint03 TransInsPoint04 TransInsPoint05 TransInsPoint06
TransInsPoint01 TransInsPoint02 TransInsPoint03 TransInsPoint04 TransInsPoint05 TransInsPoint06
TransInsPoint07 TransInsPoint08 )

;; Get transition outer points
(setq TransCntr (polar TransStart TrunkDirection TransLength))

(setq TransPoint01 (polar TransStart (TRANS_ADD_ANGLE TrunkDirection 90.0) (* 0.5 TrunkSize)))
(setq TransPoint02 (polar TransStart (TRANS_SUBTRACT_ANGLE TrunkDirection 90.0) (* 0.5 TrunkSize)))
(setq TransPoint03 (polar TransCntr (TRANS_ADD_ANGLE TrunkDirection 90.0) (* 0.5 TransOutSize)))
(setq TransPoint04 (polar TransCntr (TRANS_SUBTRACT_ANGLE TrunkDirection 90.0) (* 0.5 TransOutSize)))

;; Get transition inner point (curves for round outlet)
(setq TransBreaks (* 0.25 TransOutSize))
(setq TransPoint05 (polar TransStart (TRANS_ADD_ANGLE TrunkDirection 90.0) TransBreaks))
(setq TransPoint06 (polar TransStart (TRANS_SUBTRACT_ANGLE TrunkDirection 90.0) TransBreaks))

;; Get Insulation Points - INSIDE
(setq TransInsPoint01 (polar TransStart (TRANS_ADD_ANGLE TrunkDirection 90.0) (- 1.0 (* 0.5 TrunkSize))))
(setq TransInsPoint02 (polar TransStart (TRANS_SUBTRACT_ANGLE TrunkDirection 90.0) (- 1.0 (* 0.5 TrunkSize))))
(setq TransInsPoint03 (polar TransCntr (TRANS_ADD_ANGLE TrunkDirection 90.0) (- 1.0 (* 0.5 TransOutSize))))
(setq TransInsPoint04 (polar TransCntr (TRANS_SUBTRACT_ANGLE TrunkDirection 90.0) (- 1.0 (* 0.5 TransOutSize))))
;; Get Insulation Points - OUTSIDE
(setq TransInsPoint05 (polar TransStart (TRANS_ADD_ANGLE TrunkDirection 90.0) (+ 1.0 (* 0.5 TrunkSize))))
(setq TransInsPoint06 (polar TransStart (TRANS_SUBTRACT_ANGLE TrunkDirection 90.0) (+ 1.0 (* 0.5 TrunkSize))))
(setq TransInsPoint07 (polar TransCntr (TRANS_ADD_ANGLE TrunkDirection 90.0) (+ 1.0 (* 0.5 TransOutSize))))
(setq TransInsPoint08 (polar TransCntr (TRANS_SUBTRACT_ANGLE TrunkDirection 90.0) (+ 1.0 (* 0.5 TransOutSize))))

;; Draw Transition
(vlax-invoke space 'addline TransPoint01 TransPoint02)
(vlax-invoke space 'addline TransPoint02 TransPoint04)
(vlax-invoke space 'addline TransPoint04 TransPoint03)
(vlax-invoke space 'addline TransPoint03 TransPoint01)

;; Change layer color
(setvar "CECOLOR" "8")

;; Draw Transition Breaks
(vlax-invoke space 'addline TransPoint03 TransPoint05)
(vlax-invoke space 'addline TransPoint04 TransPoint06)
(vlax-invoke space 'addline TransPoint03 TransStart)
(vlax-invoke space 'addline TransPoint04 TransStart)

;; Set Center Line properties
(setvar "CLAYER" "M-HVAC-CNTR")
(setvar "CECOLOR" "BYLAYER")

;; Draw Centerline
(vlax-invoke space 'addline TransStart TransCntr)

;; Set Insulation Line properties
(setvar "CLAYER" "M-HVAC-INSL")

;; Draw Insulation
(if (= (strcase TransInsul) "INSIDE")
(progn
(vlax-invoke space 'addline TransInsPoint01 TransInsPoint03)
(vlax-invoke space 'addline TransInsPoint02 TransInsPoint04)
)
)
(if (= (strcase TransInsul) "OUTSIDE")
(progn
(vlax-invoke space 'addline TransInsPoint05 TransInsPoint07)
(vlax-invoke space 'addline TransInsPoint06 TransInsPoint08)
)
)
(if (= (strcase TransInsul) "BOTH")
(progn
(vlax-invoke space 'addline TransInsPoint01 TransInsPoint03)
(vlax-invoke space 'addline TransInsPoint02 TransInsPoint04)
(vlax-invoke space 'addline TransInsPoint05 TransInsPoint07)
(vlax-invoke space 'addline TransInsPoint06 TransInsPoint08)
)
)
(TRANS_RESET_ENV)
)
;;; ------------ LAYER CREATION ROUINE
(defun TRANS_CREATE_LAYER (Layer Descpition Linetype Thickness Color Plot / TmpList VLA-Obj)

;; Check to see if linetype exsists
(if (= (tblsearch "ltype" Linetype) nil)
(if (TRANS_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 TRANS_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(TRANS_STRING_TO_LIST CurrentLine ","))2))
(if (= (strcase Linetype) LinetypeName)
(setq Result T)
)
)
)
)
(close OpenFile)
Result
)
;;; ------------ STRING TO LIST SUB ROUTINE
(defun TRANS_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 TRANS_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 TRANS_ADD_ANGLE (Radians AddAngle / )
(TRANS_DTR(+ (TRANS_RTD Radians) AddAngle))
)

(defun TRANS_SUBTRACT_ANGLE (Radians AddAngle / )
(TRANS_DTR(- (TRANS_RTD Radians) AddAngle))
)
;;; ------------ ROUND NUMBER
(defun TRANS_RND (Number Precision)
(setq Number(distof (rtos Number 4 Precision)4))
)
;; ------------ DEGREES / RADIANS SUB ROUTINES
(defun TRANS_DTR (NumberOfDegrees)
(* pi (/ NumberOfDegrees 180.0))
)
(defun TRANS_RTD (NumberOfRadians)
(* 180.0 (/ NumberOfRadians pi))
)
;;; ------------ LAW OF SINS (2 ANGLES & 1 SIDE)
(defun TRANS_LoSIN (SinAngle1 SinAngle2 Side1 Round / A SinA SinB Sidelength)

(setq SinA (sin (TRANS_DTR SinAngle1)))
(setq SinB (sin (TRANS_DTR SinAngle2)))
(if (= Round 1)
(setq SideLength (TRANS_RND (/ (* Side1 SinB) SinA)4))
(setq SideLength (/ (* Side1 SinB) SinA))
)
Sidelength
)
;;; ------------ RESET SYSEM VARIABLES
(defun TRANS_RESET_ENV (/)

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

HVAC TakeOff Creator


;;; ------------------------------------------------------------------------
;;; CreateTakeoff.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:TAKEOFF (/)(TAKEOFF_START))
;;; ------------ MAIN FUNCTION
(defun TAKEOFF_START (/
*error*

)
;;; 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 (SQ TakeOffSize TakeOffInsPoint TakeOffEntry TakeOffInsul)
)
((and(= (strcase TrunkStyle) "SQUARE")(= (strcase TakeOffStyle) "ROUND"))
(TAKEOFF_SQ->TAKEOFF_RND TakeOffSize TakeOffInsPoint TakeOffEntry TakeOffInsul)
)
((and(= (strcase TrunkStyle) "ROUND")(= (strcase TakeOffStyle) "ROUND"))
(TAKEOFF_RND->SQ TakeOffSize TakeOffInsPoint TakeOffEntry TakeOffInsul)
)
((and(= (strcase TrunkStyle) "ROUND")(= (strcase TakeOffStyle) "SQUARE"))
(TAKEOFF_RND->SQ TakeOffSize TakeOffInsPoint TakeOffEntry TakeOffInsul)
)
)
)
;;; ------------ SQUARE TO SQUARE TAKEOFF
(defun TAKEOFF_SQ->SQ (TakeOffSize TakeOffInsPoint TakeOffEntry TakeOffInsul /
TakeOffPoint1
TakeOffPoint2
TakeOffPoint3
TakeOffPoint4
TakeOffPoint5
TakeOffPoint6
TakeOffPoint7
TakeOffPoint8
TakeOffPoint9
TakeOffPoint10
TakeOffPoint11
TakeOffPoint12
TakeOffPoint13
TakeOffLine1
TakeOffLine2
TakeOffLine3
TakeOffLine4
TakeOffCntrLine1
TakeOffFlare
)

(cond
((= (strcase TakeOffEntry) "SINGLE")
;; Get takeoff outer points
(setq TakeOffPoint1 (polar TakeOffInsPoint FlowDirection (/ TakeoffSize 2)))
(setq TakeOffPoint2 (polar TakeOffInsPoint (TAKEOFF_DTR (+ (TAKEOFF_RTD FlowDirection)180)) TakeoffSize))
(setq TakeOffPoint3 (polar TakeOffPoint1 TakeOffAngle (/ TakeoffSize 2)))
(setq TakeOffPoint4 (polar TakeOffPoint3 (TAKEOFF_DTR (+ (TAKEOFF_RTD FlowDirection)180)) TakeoffSize))

;; Get transition center end point
(setq TakeOffPoint5 (polar TakeOffInsPoint TakeOffAngle (/ TakeoffSize 2)))

;; Draw Transition
(setq TakeOffLine1 (vlax-invoke Space 'addline TakeOffPoint1 TakeOffPoint3))
(setq TakeOffLine2 (vlax-invoke Space 'addline TakeOffPoint3 TakeOffPoint4))
(setq TakeOffLine3 (vlax-invoke Space 'addline TakeOffPoint4 TakeOffPoint2))

(cond
((= (strcase TakeOffInsul) "OUTSIDE")
;; Setup layer
(TAKEOFF_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")
;; Get takeoff insulation points - OUTSIDE -
(setq TakeOffPoint6 (polar (polar TakeOffPoint1 FlowDirection 1) TakeOffAngle 1))
(setq TakeOffPoint7 (polar TakeOffPoint2 TakeOffAngle 1))
(setq TakeOffPoint8 (polar TakeOffPoint3 FlowDirection 1))
(setq TakeOffPoint9 (polar TakeOffPoint4 (+ FlowDirection (TAKEOFF_DTR 180)) 1))

;; Draw insulation
(setq TakeOffLine4 (vlax-invoke Space 'addline TakeOffPoint6 TakeOffPoint8))
(setq TakeOffLine5 (vlax-invoke Space 'addline TakeOffPoint9 TakeOffPoint7))

;; Set properties for insulation
(vlax-put TakeOffLine4 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine5 'Layer "M-HVAC-INSL")
)
((= (strcase TakeOffInsul) "INSIDE")
;; Setup layer
(TAKEOFF_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")

;; Get takeoff insulation points - INSIDE -
(setq TakeOffPoint10 (polar (polar TakeOffPoint1 (- FlowDirection (TAKEOFF_DTR 180)) 1) Angle-180 1))
(setq TakeOffPoint11 (polar TakeOffPoint2 Angle-180 1))
(setq TakeOffPoint12 (polar TakeOffPoint3 (+ FlowDirection (TAKEOFF_DTR 180)) 1))
(setq TakeOffPoint13 (polar TakeOffPoint4 FlowDirection 1))

;;; Draw insulation
(setq TakeOffLine6 (vlax-invoke Space 'addline TakeOffPoint10 TakeOffPoint12))
(setq TakeOffLine7 (vlax-invoke Space 'addline TakeOffPoint13 TakeOffPoint11))

;; Set properties for insulation
(vlax-put TakeOffLine6 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine7 'Layer "M-HVAC-INSL")
)
((= (strcase TakeOffInsul) "BOTH")
;; Setup layer
(TAKEOFF_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")

;; Get takeoff insulation points - OUTSIDE -
(setq TakeOffPoint6 (polar (polar TakeOffPoint1 FlowDirection 1) TakeOffAngle 1))
(setq TakeOffPoint7 (polar TakeOffPoint2 TakeOffAngle 1))
(setq TakeOffPoint8 (polar TakeOffPoint3 FlowDirection 1))
(setq TakeOffPoint9 (polar TakeOffPoint4 (+ FlowDirection (TAKEOFF_DTR 180)) 1))
;; Get takeoff insulation points - INSIDE -
(setq TakeOffPoint10 (polar (polar TakeOffPoint1 (- FlowDirection (TAKEOFF_DTR 180)) 1) Angle-180 1))
(setq TakeOffPoint11 (polar TakeOffPoint2 Angle-180 1))
(setq TakeOffPoint12 (polar TakeOffPoint3 (+ FlowDirection (TAKEOFF_DTR 180)) 1))
(setq TakeOffPoint13 (polar TakeOffPoint4 FlowDirection 1))

;;; Draw insulation
(setq TakeOffLine4 (vlax-invoke Space 'addline TakeOffPoint10 TakeOffPoint12))
(setq TakeOffLine5 (vlax-invoke Space 'addline TakeOffPoint13 TakeOffPoint11))
(setq TakeOffLine6 (vlax-invoke Space 'addline TakeOffPoint6 TakeOffPoint8))
(setq TakeOffLine7 (vlax-invoke Space 'addline TakeOffPoint9 TakeOffPoint7))

;; Set properties for insulation
(vlax-put TakeOffLine4 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine5 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine6 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine7 'Layer "M-HVAC-INSL")
)
)
)
((= (strcase TakeOffEntry) "DOUBLE")
(setq TakeOffFlare (TAKEOFF_LAWOFSINE 60 30 (/ TakeoffSize 2)))
;; Get takeoff outer points
(setq TakeOffPoint1 (polar TakeOffInsPoint Angle-90 (+ (/ TakeoffSize 2) TakeOffFlare)))
(setq TakeOffPoint2 (polar TakeOffInsPoint Angle+90 (+ (/ TakeoffSize 2) TakeOffFlare)))
(setq TakeOffPoint3 (polar (polar TakeOffInsPoint Angle-90 (/ TakeoffSize 2)) TakeOffAngle (/ TakeoffSize 2)))
(setq TakeOffPoint4 (polar (polar TakeOffInsPoint Angle+90 (/ TakeoffSize 2)) TakeOffAngle (/ TakeoffSize 2)))

;; Get transition center end point
(setq TakeOffPoint5 (polar TakeOffInsPoint TakeOffAngle (/ TakeoffSize 2)))

;; Draw Transition
(setq TakeOffLine1 (vlax-invoke Space 'addline TakeOffPoint1 TakeOffPoint3))
(setq TakeOffLine2 (vlax-invoke Space 'addline TakeOffPoint3 TakeOffPoint4))
(setq TakeOffLine3 (vlax-invoke Space 'addline TakeOffPoint4 TakeOffPoint2))

;; Get points / draw insulation
(cond
((= (strcase TakeOffInsul) "OUTSIDE")
;; Setup layer
(TAKEOFF_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")
;; Get takeoff insulation points - OUTSIDE -
(setq TakeOffPoint6 (polar (polar TakeOffPoint1 Angle-90 (TAKEOFF_LAWOFSINE 60 30 1)) TakeOffAngle 1))
(setq TakeOffPoint7 (polar (polar TakeOffPoint2 Angle+90 (TAKEOFF_LAWOFSINE 60 30 1)) TakeOffAngle 1))
(setq TakeOffPoint8 (polar TakeOffPoint3 Angle-90 1))
(setq TakeOffPoint9 (polar TakeOffPoint4 Angle+90 1))

;; Draw insulation
(setq TakeOffLine4 (vlax-invoke Space 'addline TakeOffPoint6 TakeOffPoint8))
(setq TakeOffLine5 (vlax-invoke Space 'addline TakeOffPoint9 TakeOffPoint7))

;; Set properties for insulation
(vlax-put TakeOffLine4 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine5 'Layer "M-HVAC-INSL")
)
((= (strcase TakeOffInsul) "INSIDE")
;; Setup layer
(TAKEOFF_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")

;; Get takeoff insulation points - INSIDE -
(setq TakeOffPoint10 (polar (polar TakeOffPoint1 Angle+90 (TAKEOFF_LAWOFSINE 60 30 1)) Angle-180 1))
(setq TakeOffPoint11 (polar (polar TakeOffPoint2 Angle-90 (TAKEOFF_LAWOFSINE 60 30 1)) Angle-180 1))
(setq TakeOffPoint12 (polar TakeOffPoint3 Angle+90 1))
(setq TakeOffPoint13 (polar TakeOffPoint4 Angle-90 1))

;;; Draw insulation
(setq TakeOffLine6 (vlax-invoke Space 'addline TakeOffPoint10 TakeOffPoint12))
(setq TakeOffLine7 (vlax-invoke Space 'addline TakeOffPoint13 TakeOffPoint11))

;; Set properties for insulation
(vlax-put TakeOffLine6 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine7 'Layer "M-HVAC-INSL")
)
((= (strcase TakeOffInsul) "BOTH")
;; Setup layer
(TAKEOFF_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")

;; Get takeoff insulation points - OUTSIDE -
(setq TakeOffPoint6 (polar (polar TakeOffPoint1 Angle-90 (TAKEOFF_LAWOFSINE 60 30 1)) TakeOffAngle 1))
(setq TakeOffPoint7 (polar (polar TakeOffPoint2 Angle+90 (TAKEOFF_LAWOFSINE 60 30 1)) TakeOffAngle 1))
(setq TakeOffPoint8 (polar TakeOffPoint3 Angle-90 1))
(setq TakeOffPoint9 (polar TakeOffPoint4 Angle+90 1))
;; Get takeoff insulation points - INSIDE -
(setq TakeOffPoint10 (polar (polar TakeOffPoint1 Angle+90 (TAKEOFF_LAWOFSINE 60 30 1)) Angle-180 1))
(setq TakeOffPoint11 (polar (polar TakeOffPoint2 Angle-90 (TAKEOFF_LAWOFSINE 60 30 1)) Angle-180 1))
(setq TakeOffPoint12 (polar TakeOffPoint3 Angle+90 1))
(setq TakeOffPoint13 (polar TakeOffPoint4 Angle-90 1))

;;; Draw insulation
(setq TakeOffLine4 (vlax-invoke Space 'addline TakeOffPoint10 TakeOffPoint12))
(setq TakeOffLine5 (vlax-invoke Space 'addline TakeOffPoint13 TakeOffPoint11))
(setq TakeOffLine6 (vlax-invoke Space 'addline TakeOffPoint6 TakeOffPoint8))
(setq TakeOffLine7 (vlax-invoke Space 'addline TakeOffPoint9 TakeOffPoint7))

;; Set properties for insulation
(vlax-put TakeOffLine4 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine5 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine6 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine7 'Layer "M-HVAC-INSL")
)
)
)
)

;; Setup layer for centerline
(TAKEOFF_CREATE_LAYER "M-HVAC-CNTR" "Mechanical Plan - Ductwork centerline" "CENTER2" "25" "12" "0")
;; Draw Centerline
(setq TakeOffCntrLine1 (vlax-invoke Space 'addline TakeOffInsPoint TakeOffPoint5))
;; Set properties for centerline
(vlax-put TakeOffCntrLine1 'Layer "M-HVAC-CNTR")

;; Reset envireonment
(TAKEOFF_RESET_ENV)

)
;;; ------------ SQUARE TO SQUARE TAKEOFF
(defun TAKEOFF_SQ->TAKEOFF_RND (TakeOffSize TakeOffInsPoint TakeOffEntry TakeOffInsul /
TakeOffPoint1
TakeOffPoint2
TakeOffPoint3
TakeOffPoint4
TakeOffPoint5
TakeOffPoint6
TakeOffPoint7
TakeOffPoint8
TakeOffPoint9
TakeOffPoint10
TakeOffPoint11
TakeOffPoint12
TakeOffPoint13
TakeOffLine1
TakeOffLine2
TakeOffLine3
TakeOffLine4
TakeOffCntrLine1
TakeOffFlare
TakeOffBreakPoint1
TakeOffBreakPoint2
TakeOffBreakLine1
TakeOffBreakLine2
TakeOffBreakLine3
TakeOffBreakLine4
)

(cond
((= (strcase TakeOffEntry) "SINGLE")
;; Get takeoff outer points
(setq TakeOffPoint1 (polar TakeOffInsPoint FlowDirection (/ TakeoffSize 2)))
(setq TakeOffPoint2 (polar TakeOffInsPoint (TAKEOFF_DTR (+ (TAKEOFF_RTD FlowDirection)180)) TakeoffSize))
(setq TakeOffPoint3 (polar TakeOffPoint1 TakeOffAngle (/ TakeoffSize 2)))
(setq TakeOffPoint4 (polar TakeOffPoint3 (TAKEOFF_DTR (+ (TAKEOFF_RTD FlowDirection)180)) TakeoffSize))

;; Get transition center end point
(setq TakeOffPoint5 (polar TakeOffInsPoint TakeOffAngle (/ TakeoffSize 2)))

;; Get transition inner point (curves for round outlet)
(setq TakeOffBreakPoint1 (polar TakeOffPoint5 FlowDirection (/ (/ TakeoffSize 2)2)))
(setq TakeOffBreakPoint2 (polar TakeOffPoint5 (TAKEOFF_DTR (+ (TAKEOFF_RTD FlowDirection)180)) (/ (/ TakeoffSize 2)2)))

;; Draw Transition
(setq TakeOffLine1 (vlax-invoke Space 'addline TakeOffPoint1 TakeOffPoint3))
(setq TakeOffLine2 (vlax-invoke Space 'addline TakeOffPoint3 TakeOffPoint4))
(setq TakeOffLine3 (vlax-invoke Space 'addline TakeOffPoint4 TakeOffPoint2))

;; Draw breaks
(setq TakeOffBreakLine1 (vlax-invoke Space 'addline TakeOffPoint1 TakeOffPoint5))
(setq TakeOffBreakLine2 (vlax-invoke Space 'addline TakeOffPoint1 TakeOffBreakPoint1))
(setq TakeOffBreakLine3 (vlax-invoke Space 'addline TakeOffPoint2 TakeOffPoint5))
(setq TakeOffBreakLine4 (vlax-invoke Space 'addline TakeOffPoint2 TakeOffBreakPoint2))

;; Set properties for insulation
(vlax-put TakeOffBreakLine1 'Color 8)
(vlax-put TakeOffBreakLine2 'Color 8)
(vlax-put TakeOffBreakLine3 'Color 8)
(vlax-put TakeOffBreakLine4 'Color 8)

(cond
((= (strcase TakeOffInsul) "OUTSIDE")
;; Setup layer
(TAKEOFF_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")
;; Get takeoff insulation points - OUTSIDE -
(setq TakeOffPoint6 (polar (polar TakeOffPoint1 FlowDirection 1) TakeOffAngle 1))
(setq TakeOffPoint7 (polar TakeOffPoint2 TakeOffAngle 1))
(setq TakeOffPoint8 (polar TakeOffPoint3 FlowDirection 1))
(setq TakeOffPoint9 (polar TakeOffPoint4 (+ FlowDirection (TAKEOFF_DTR 180)) 1))

;; Draw insulation
(setq TakeOffLine4 (vlax-invoke Space 'addline TakeOffPoint6 TakeOffPoint8))
(setq TakeOffLine5 (vlax-invoke Space 'addline TakeOffPoint9 TakeOffPoint7))

;; Set properties for insulation
(vlax-put TakeOffLine4 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine5 'Layer "M-HVAC-INSL")
)
((= (strcase TakeOffInsul) "INSIDE")
;; Setup layer
(TAKEOFF_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")

;; Get takeoff insulation points - INSIDE -
(setq TakeOffPoint10 (polar (polar TakeOffPoint1 (- FlowDirection (TAKEOFF_DTR 180)) 1) Angle-180 1))
(setq TakeOffPoint11 (polar TakeOffPoint2 Angle-180 1))
(setq TakeOffPoint12 (polar TakeOffPoint3 (+ FlowDirection (TAKEOFF_DTR 180)) 1))
(setq TakeOffPoint13 (polar TakeOffPoint4 FlowDirection 1))

;;; Draw insulation
(setq TakeOffLine6 (vlax-invoke Space 'addline TakeOffPoint10 TakeOffPoint12))
(setq TakeOffLine7 (vlax-invoke Space 'addline TakeOffPoint13 TakeOffPoint11))

;; Set properties for insulation
(vlax-put TakeOffLine6 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine7 'Layer "M-HVAC-INSL")
)
((= (strcase TakeOffInsul) "BOTH")
;; Setup layer
(TAKEOFF_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")

;; Get takeoff insulation points - OUTSIDE -
(setq TakeOffPoint6 (polar (polar TakeOffPoint1 FlowDirection 1) TakeOffAngle 1))
(setq TakeOffPoint7 (polar TakeOffPoint2 TakeOffAngle 1))
(setq TakeOffPoint8 (polar TakeOffPoint3 FlowDirection 1))
(setq TakeOffPoint9 (polar TakeOffPoint4 (+ FlowDirection (TAKEOFF_DTR 180)) 1))
;; Get takeoff insulation points - INSIDE -
(setq TakeOffPoint10 (polar (polar TakeOffPoint1 (- FlowDirection (TAKEOFF_DTR 180)) 1) Angle-180 1))
(setq TakeOffPoint11 (polar TakeOffPoint2 Angle-180 1))
(setq TakeOffPoint12 (polar TakeOffPoint3 (+ FlowDirection (TAKEOFF_DTR 180)) 1))
(setq TakeOffPoint13 (polar TakeOffPoint4 FlowDirection 1))

;;; Draw insulation
(setq TakeOffLine4 (vlax-invoke Space 'addline TakeOffPoint10 TakeOffPoint12))
(setq TakeOffLine5 (vlax-invoke Space 'addline TakeOffPoint13 TakeOffPoint11))
(setq TakeOffLine6 (vlax-invoke Space 'addline TakeOffPoint6 TakeOffPoint8))
(setq TakeOffLine7 (vlax-invoke Space 'addline TakeOffPoint9 TakeOffPoint7))

;; Set properties for insulation
(vlax-put TakeOffLine4 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine5 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine6 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine7 'Layer "M-HVAC-INSL")
)
)
)
((= (strcase TakeOffEntry) "DOUBLE")
(setq TakeOffFlare (TAKEOFF_LAWOFSINE 60 30 (/ TakeoffSize 2)))
;; Get takeoff outer points
(setq TakeOffPoint1 (polar TakeOffInsPoint Angle-90 (+ (/ TakeoffSize 2) TakeOffFlare)))
(setq TakeOffPoint2 (polar TakeOffInsPoint Angle+90 (+ (/ TakeoffSize 2) TakeOffFlare)))
(setq TakeOffPoint3 (polar (polar TakeOffInsPoint Angle-90 (/ TakeoffSize 2)) TakeOffAngle (/ TakeoffSize 2)))
(setq TakeOffPoint4 (polar (polar TakeOffInsPoint Angle+90 (/ TakeoffSize 2)) TakeOffAngle (/ TakeoffSize 2)))

;; Get transition center end point
(setq TakeOffPoint5 (polar TakeOffInsPoint TakeOffAngle (/ TakeoffSize 2)))

;; Get transition inner point (curves for round outlet)
(setq TakeOffBreakPoint1 (polar TakeOffPoint5 Angle-90 (/ (/ TakeoffSize 2)2)))
(setq TakeOffBreakPoint2 (polar TakeOffPoint5 Angle+90 (/ (/ TakeoffSize 2)2)))

;; Draw Transition
(setq TakeOffLine1 (vlax-invoke Space 'addline TakeOffPoint1 TakeOffPoint3))
(setq TakeOffLine2 (vlax-invoke Space 'addline TakeOffPoint3 TakeOffPoint4))
(setq TakeOffLine3 (vlax-invoke Space 'addline TakeOffPoint4 TakeOffPoint2))

;; Draw breaks
(setq TakeOffBreakLine1 (vlax-invoke Space 'addline TakeOffPoint1 TakeOffPoint5))
(setq TakeOffBreakLine2 (vlax-invoke Space 'addline TakeOffPoint1 TakeOffBreakPoint1))
(setq TakeOffBreakLine3 (vlax-invoke Space 'addline TakeOffPoint2 TakeOffPoint5))
(setq TakeOffBreakLine4 (vlax-invoke Space 'addline TakeOffPoint2 TakeOffBreakPoint2))

;; Set properties for insulation
(vlax-put TakeOffBreakLine1 'Color 8)
(vlax-put TakeOffBreakLine2 'Color 8)
(vlax-put TakeOffBreakLine3 'Color 8)
(vlax-put TakeOffBreakLine4 'Color 8)

;; Get points / draw insulation
(cond
((= (strcase TakeOffInsul) "OUTSIDE")
;; Setup layer
(TAKEOFF_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")
;; Get takeoff insulation points - OUTSIDE -
(setq TakeOffPoint6 (polar (polar TakeOffPoint1 Angle-90 (TAKEOFF_LAWOFSINE 60 30 1)) TakeOffAngle 1))
(setq TakeOffPoint7 (polar (polar TakeOffPoint2 Angle+90 (TAKEOFF_LAWOFSINE 60 30 1)) TakeOffAngle 1))
(setq TakeOffPoint8 (polar TakeOffPoint3 Angle-90 1))
(setq TakeOffPoint9 (polar TakeOffPoint4 Angle+90 1))

;; Draw insulation
(setq TakeOffLine4 (vlax-invoke Space 'addline TakeOffPoint6 TakeOffPoint8))
(setq TakeOffLine5 (vlax-invoke Space 'addline TakeOffPoint9 TakeOffPoint7))

;; Set properties for insulation
(vlax-put TakeOffLine4 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine5 'Layer "M-HVAC-INSL")
)
((= (strcase TakeOffInsul) "INSIDE")
;; Setup layer
(TAKEOFF_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")

;; Get takeoff insulation points - INSIDE -
(setq TakeOffPoint10 (polar (polar TakeOffPoint1 Angle+90 (TAKEOFF_LAWOFSINE 60 30 1)) Angle-180 1))
(setq TakeOffPoint11 (polar (polar TakeOffPoint2 Angle-90 (TAKEOFF_LAWOFSINE 60 30 1)) Angle-180 1))
(setq TakeOffPoint12 (polar TakeOffPoint3 Angle+90 1))
(setq TakeOffPoint13 (polar TakeOffPoint4 Angle-90 1))

;;; Draw insulation
(setq TakeOffLine6 (vlax-invoke Space 'addline TakeOffPoint10 TakeOffPoint12))
(setq TakeOffLine7 (vlax-invoke Space 'addline TakeOffPoint13 TakeOffPoint11))

;; Set properties for insulation
(vlax-put TakeOffLine6 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine7 'Layer "M-HVAC-INSL")
)
((= (strcase TakeOffInsul) "BOTH")
;; Setup layer
(TAKEOFF_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")

;; Get takeoff insulation points - OUTSIDE -
(setq TakeOffPoint6 (polar (polar TakeOffPoint1 Angle-90 (TAKEOFF_LAWOFSINE 60 30 1)) TakeOffAngle 1))
(setq TakeOffPoint7 (polar (polar TakeOffPoint2 Angle+90 (TAKEOFF_LAWOFSINE 60 30 1)) TakeOffAngle 1))
(setq TakeOffPoint8 (polar TakeOffPoint3 Angle-90 1))
(setq TakeOffPoint9 (polar TakeOffPoint4 Angle+90 1))
;; Get takeoff insulation points - INSIDE -
(setq TakeOffPoint10 (polar (polar TakeOffPoint1 Angle+90 (TAKEOFF_LAWOFSINE 60 30 1)) Angle-180 1))
(setq TakeOffPoint11 (polar (polar TakeOffPoint2 Angle-90 (TAKEOFF_LAWOFSINE 60 30 1)) Angle-180 1))
(setq TakeOffPoint12 (polar TakeOffPoint3 Angle+90 1))
(setq TakeOffPoint13 (polar TakeOffPoint4 Angle-90 1))

;;; Draw insulation
(setq TakeOffLine4 (vlax-invoke Space 'addline TakeOffPoint10 TakeOffPoint12))
(setq TakeOffLine5 (vlax-invoke Space 'addline TakeOffPoint13 TakeOffPoint11))
(setq TakeOffLine6 (vlax-invoke Space 'addline TakeOffPoint6 TakeOffPoint8))
(setq TakeOffLine7 (vlax-invoke Space 'addline TakeOffPoint9 TakeOffPoint7))

;; Set properties for insulation
(vlax-put TakeOffLine4 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine5 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine6 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine7 'Layer "M-HVAC-INSL")
)
)
)
)

;; Setup layer for centerline
(TAKEOFF_CREATE_LAYER "M-HVAC-CNTR" "Mechanical Plan - Ductwork centerline" "CENTER2" "25" "12" "0")
;; Draw Centerline
(setq TakeOffCntrLine1 (vlax-invoke Space 'addline TakeOffInsPoint TakeOffPoint5))
;; Set properties for centerline
(vlax-put TakeOffCntrLine1 'Layer "M-HVAC-CNTR")

;; Reset envireonment
(TAKEOFF_RESET_ENV)

)
;;; ------------ SQUARE TO SQUARE TAKEOFF
(defun TAKEOFF_RND->SQ (TakeOffSize TakeOffInsPoint TakeOffEntry TakeOffInsul /
TakeOffPoint1
TakeOffPoint2
TakeOffPoint3
TakeOffPoint4
TakeOffPoint5
TakeOffPoint6
TakeOffPoint7
TakeOffPoint8
TakeOffPoint9
TakeOffPoint10
TakeOffPoint11
TakeOffPoint12
TakeOffPoint13
TakeOffLine1
TakeOffLine2
TakeOffLine3
TakeOffLine4
TakeOffCntrLine1
TakeOffFlare
TakeOffMidPt1
TakeOffArcPt1
TakeOffArcPt2
)

(cond
((= (strcase TakeOffEntry) "SINGLE")
;; Get takeoff outer points
(setq TakeOffPoint1 (polar TakeOffInsPoint FlowDirection (/ TakeoffSize 2)))
(setq TakeOffPoint2 (polar TakeOffInsPoint (TAKEOFF_DTR (+ (TAKEOFF_RTD FlowDirection)180)) TakeoffSize))
(setq TakeOffPoint3 (polar TakeOffPoint1 TakeOffAngle (/ TakeoffSize 2)))
(setq TakeOffPoint4 (polar TakeOffPoint3 (TAKEOFF_DTR (+ (TAKEOFF_RTD FlowDirection)180)) TakeoffSize))
(setq TakeOffMidPt1 (polar TakeOffPoint1 (TAKEOFF_DTR (+ (TAKEOFF_RTD FlowDirection)180)) (/ (distance TakeOffPoint1 TakeOffPoint2) 2)))
(setq TakeOffArcPt1 (polar TakeOffMidPt1 (TAKEOFF_DTR (+ (TAKEOFF_RTD TakeOffAngle)180))(/ TakeoffSize 4)))
(setq TakeOffArcPt2 (polar TakeOffArcPt1 TakeOffAngle (setq TakeOffRad (TAKEOFF_GET_RADIUS (distance TakeOffPoint1 TakeOffPoint2)(distance TakeOffMidPt1 TakeOffArcPt1)))))

;; Get transition center end point
(setq TakeOffPoint5 (polar TakeOffInsPoint TakeOffAngle (/ TakeoffSize 2)))

;; Draw Transition
(setq TakeOffLine1 (vlax-invoke Space 'addline TakeOffPoint1 TakeOffPoint3))
(setq TakeOffLine2 (vlax-invoke Space 'addline TakeOffPoint3 TakeOffPoint4))
(setq TakeOffLine3 (vlax-invoke Space 'addline TakeOffPoint4 TakeOffPoint2))
(command "_arc" TakeOffPoint1 TakeOffArcPt1 TakeOffPoint2)

(cond
((= (strcase TakeOffInsul) "OUTSIDE")
;; Setup layer
(TAKEOFF_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")
;; Get takeoff insulation points - OUTSIDE -
(setq TakeOffPoint6 (polar (polar TakeOffPoint1 FlowDirection 1) TakeOffAngle 1))
(setq TakeOffPoint7 (polar TakeOffPoint2 TakeOffAngle 1))
(setq TakeOffPoint8 (polar TakeOffPoint3 FlowDirection 1))
(setq TakeOffPoint9 (polar TakeOffPoint4 (+ FlowDirection (TAKEOFF_DTR 180)) 1))

;; Draw insulation
(setq TakeOffLine4 (vlax-invoke Space 'addline TakeOffPoint6 TakeOffPoint8))
(setq TakeOffLine5 (vlax-invoke Space 'addline TakeOffPoint9 TakeOffPoint7))

;; Set properties for insulation
(vlax-put TakeOffLine4 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine5 'Layer "M-HVAC-INSL")
)
((= (strcase TakeOffInsul) "INSIDE")
;; Setup layer
(TAKEOFF_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")

;; Get takeoff insulation points - INSIDE -
(setq TakeOffPoint10 (polar (polar TakeOffPoint1 (- FlowDirection (TAKEOFF_DTR 180)) 1) Angle-180 1))
(setq TakeOffPoint11 (polar TakeOffPoint2 Angle-180 1))
(setq TakeOffPoint12 (polar TakeOffPoint3 (+ FlowDirection (TAKEOFF_DTR 180)) 1))
(setq TakeOffPoint13 (polar TakeOffPoint4 FlowDirection 1))

;;; Draw insulation
(setq TakeOffLine6 (vlax-invoke Space 'addline TakeOffPoint10 TakeOffPoint12))
(setq TakeOffLine7 (vlax-invoke Space 'addline TakeOffPoint13 TakeOffPoint11))

;; Set properties for insulation
(vlax-put TakeOffLine6 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine7 'Layer "M-HVAC-INSL")
)
((= (strcase TakeOffInsul) "BOTH")
;; Setup layer
(TAKEOFF_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")

;; Get takeoff insulation points - OUTSIDE -
(setq TakeOffPoint6 (polar (polar TakeOffPoint1 FlowDirection 1) TakeOffAngle 1))
(setq TakeOffPoint7 (polar TakeOffPoint2 TakeOffAngle 1))
(setq TakeOffPoint8 (polar TakeOffPoint3 FlowDirection 1))
(setq TakeOffPoint9 (polar TakeOffPoint4 (+ FlowDirection (TAKEOFF_DTR 180)) 1))
;; Get takeoff insulation points - INSIDE -
(setq TakeOffPoint10 (polar (polar TakeOffPoint1 (- FlowDirection (TAKEOFF_DTR 180)) 1) Angle-180 1))
(setq TakeOffPoint11 (polar TakeOffPoint2 Angle-180 1))
(setq TakeOffPoint12 (polar TakeOffPoint3 (+ FlowDirection (TAKEOFF_DTR 180)) 1))
(setq TakeOffPoint13 (polar TakeOffPoint4 FlowDirection 1))

;;; Draw insulation
(setq TakeOffLine4 (vlax-invoke Space 'addline TakeOffPoint10 TakeOffPoint12))
(setq TakeOffLine5 (vlax-invoke Space 'addline TakeOffPoint13 TakeOffPoint11))
(setq TakeOffLine6 (vlax-invoke Space 'addline TakeOffPoint6 TakeOffPoint8))
(setq TakeOffLine7 (vlax-invoke Space 'addline TakeOffPoint9 TakeOffPoint7))

;; Set properties for insulation
(vlax-put TakeOffLine4 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine5 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine6 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine7 'Layer "M-HVAC-INSL")
)
)
)
((= (strcase TakeOffEntry) "DOUBLE")
(setq TakeOffFlare (TAKEOFF_LAWOFSINE 60 30 (/ TakeoffSize 2)))
;; Get takeoff outer points
(setq TakeOffPoint1 (polar TakeOffInsPoint Angle-90 (+ (/ TakeoffSize 2) TakeOffFlare)))
(setq TakeOffPoint2 (polar TakeOffInsPoint Angle+90 (+ (/ TakeoffSize 2) TakeOffFlare)))
(setq TakeOffPoint3 (polar (polar TakeOffInsPoint Angle-90 (/ TakeoffSize 2)) TakeOffAngle (/ TakeoffSize 2)))
(setq TakeOffPoint4 (polar (polar TakeOffInsPoint Angle+90 (/ TakeoffSize 2)) TakeOffAngle (/ TakeoffSize 2)))
(setq TakeOffMidPt1 (polar TakeOffPoint1 (TAKEOFF_DTR (+ (TAKEOFF_RTD FlowDirection)180)) (/ (distance TakeOffPoint1 TakeOffPoint2) 2)))
(setq TakeOffArcPt1 (polar TakeOffInsPoint (TAKEOFF_DTR (+ (TAKEOFF_RTD TakeOffAngle)180))(/ TakeoffSize 4)))
(setq TakeOffArcPt2 (polar TakeOffArcPt1 TakeOffAngle (setq TakeOffRad (TAKEOFF_GET_RADIUS (distance TakeOffPoint1 TakeOffPoint2)(distance TakeOffMidPt1 TakeOffArcPt1)))))

;; Get transition center end point
(setq TakeOffPoint5 (polar TakeOffInsPoint TakeOffAngle (/ TakeoffSize 2)))

;; Draw Transition
(setq TakeOffLine1 (vlax-invoke Space 'addline TakeOffPoint1 TakeOffPoint3))
(setq TakeOffLine2 (vlax-invoke Space 'addline TakeOffPoint3 TakeOffPoint4))
(setq TakeOffLine3 (vlax-invoke Space 'addline TakeOffPoint4 TakeOffPoint2))
(command "_arc" TakeOffPoint1 TakeOffArcPt1 TakeOffPoint2)

;; Get points / draw insulation
(cond
((= (strcase TakeOffInsul) "OUTSIDE")
;; Setup layer
(TAKEOFF_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")
;; Get takeoff insulation points - OUTSIDE -
(setq TakeOffPoint6 (polar (polar TakeOffPoint1 Angle-90 (TAKEOFF_LAWOFSINE 60 30 1)) TakeOffAngle 1))
(setq TakeOffPoint7 (polar (polar TakeOffPoint2 Angle+90 (TAKEOFF_LAWOFSINE 60 30 1)) TakeOffAngle 1))
(setq TakeOffPoint8 (polar TakeOffPoint3 Angle-90 1))
(setq TakeOffPoint9 (polar TakeOffPoint4 Angle+90 1))

;; Draw insulation
(setq TakeOffLine4 (vlax-invoke Space 'addline TakeOffPoint6 TakeOffPoint8))
(setq TakeOffLine5 (vlax-invoke Space 'addline TakeOffPoint9 TakeOffPoint7))

;; Set properties for insulation
(vlax-put TakeOffLine4 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine5 'Layer "M-HVAC-INSL")
)
((= (strcase TakeOffInsul) "INSIDE")
;; Setup layer
(TAKEOFF_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")

;; Get takeoff insulation points - INSIDE -
(setq TakeOffPoint10 (polar (polar TakeOffPoint1 Angle+90 (TAKEOFF_LAWOFSINE 60 30 1)) Angle-180 1))
(setq TakeOffPoint11 (polar (polar TakeOffPoint2 Angle-90 (TAKEOFF_LAWOFSINE 60 30 1)) Angle-180 1))
(setq TakeOffPoint12 (polar TakeOffPoint3 Angle+90 1))
(setq TakeOffPoint13 (polar TakeOffPoint4 Angle-90 1))

;;; Draw insulation
(setq TakeOffLine6 (vlax-invoke Space 'addline TakeOffPoint10 TakeOffPoint12))
(setq TakeOffLine7 (vlax-invoke Space 'addline TakeOffPoint13 TakeOffPoint11))

;; Set properties for insulation
(vlax-put TakeOffLine6 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine7 'Layer "M-HVAC-INSL")
)
((= (strcase TakeOffInsul) "BOTH")
;; Setup layer
(TAKEOFF_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")

;; Get takeoff insulation points - OUTSIDE -
(setq TakeOffPoint6 (polar (polar TakeOffPoint1 Angle-90 (TAKEOFF_LAWOFSINE 60 30 1)) TakeOffAngle 1))
(setq TakeOffPoint7 (polar (polar TakeOffPoint2 Angle+90 (TAKEOFF_LAWOFSINE 60 30 1)) TakeOffAngle 1))
(setq TakeOffPoint8 (polar TakeOffPoint3 Angle-90 1))
(setq TakeOffPoint9 (polar TakeOffPoint4 Angle+90 1))
;; Get takeoff insulation points - INSIDE -
(setq TakeOffPoint10 (polar (polar TakeOffPoint1 Angle+90 (TAKEOFF_LAWOFSINE 60 30 1)) Angle-180 1))
(setq TakeOffPoint11 (polar (polar TakeOffPoint2 Angle-90 (TAKEOFF_LAWOFSINE 60 30 1)) Angle-180 1))
(setq TakeOffPoint12 (polar TakeOffPoint3 Angle+90 1))
(setq TakeOffPoint13 (polar TakeOffPoint4 Angle-90 1))

;;; Draw insulation
(setq TakeOffLine4 (vlax-invoke Space 'addline TakeOffPoint10 TakeOffPoint12))
(setq TakeOffLine5 (vlax-invoke Space 'addline TakeOffPoint13 TakeOffPoint11))
(setq TakeOffLine6 (vlax-invoke Space 'addline TakeOffPoint6 TakeOffPoint8))
(setq TakeOffLine7 (vlax-invoke Space 'addline TakeOffPoint9 TakeOffPoint7))

;; Set properties for insulation
(vlax-put TakeOffLine4 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine5 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine6 'Layer "M-HVAC-INSL")
(vlax-put TakeOffLine7 'Layer "M-HVAC-INSL")
)
)
)
)

;; Setup layer for centerline
(TAKEOFF_CREATE_LAYER "M-HVAC-CNTR" "Mechanical Plan - Ductwork centerline" "CENTER2" "25" "12" "0")
;; Draw Centerline
(setq TakeOffCntrLine1 (vlax-invoke Space 'addline TakeOffInsPoint TakeOffPoint5))
;; Set properties for centerline
(vlax-put TakeOffCntrLine1 'Layer "M-HVAC-CNTR")

;; Reset envireonment
(TAKEOFF_RESET_ENV)

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

;; Check to see if linetype exsists
(if (= (tblsearch "ltype" Linetype) nil)
(if (TAKEOFF_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 TAKEOFF_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(TAKEOFF_STRING_TO_LIST CurrentLine ","))2))
(if (= (strcase Linetype) LinetypeName)
(setq Result T)
)
)
)
)
(close OpenFile)
Result
)
;;; ------------ STRING TO LIST SUB ROUTINE
(defun TAKEOFF_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 / RADIANS SUB ROUTINES
(defun TAKEOFF_DTR (NumberOfDegrees)
(* pi (/ NumberOfDegrees 180.0))
)
(defun TAKEOFF_RTD (NumberOfRadians)
(* 180.0 (/ NumberOfRadians pi))
)
;;; ------------ ROUND NUMBER
(defun TAKEOFF_RND (Number Precision)
(setq Number(distof (rtos Number 4 Precision)4))
)
;;; ------------ LAW OF SINS (2 ANGLES & 1 SIDE)
(defun TAKEOFF_LAWOFSINE (SinAngle1 SinAngle2 Side1 / A SinA SinB Sidelength)

(setq SinA (sin (TAKEOFF_DTR SinAngle1)))
(setq SinB (sin (TAKEOFF_DTR SinAngle2)))
(setq SideLength (TAKEOFF_RND (/ (* Side1 SinB) SinA)4))
Sidelength
)
;;; ------------ GET RADIUS OF ARC (CHORD LENGTH & CHORD HEIGHT KNOWN)
(defun TAKEOFF_GET_RADIUS (ChordLength ChordHeight / Radius)

(setq Radius (/(+(expt ChordHeight 2)(/ (expt ChordLength 2)4))(* ChordHeight 2)))
Radius
)
;;; ------------ RESET SYSEM VARIABLES
(defun TAKEOFF_RESET_ENV (/)

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

Follow

Get every new post delivered to your Inbox.

Join 31 other followers