;;; ------------------------------------------------------------------------
;;; CreateElbow.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:ELBOW (/)(ELBOW_START))
;;; ------------ MAIN FUNCTION
(defun ELBOW_START (/ *error* TrunkLine ElbowStart SidePoint EntList ElbowLayer LineStart LineEnd LineAngle TrunkSize
TrunkDirection ElbowCorner MidPoint SidePoint2 ElbowDirection ElbowEnd ElbowCenter ConnAngle MidAngle ElbowMid
ElbowChord ElbowRadius OldClayer OldCmdEcho OldOsmode)

;;; Begin Error Handler -------------------------------------------------
(defun *error* (MSG)

(if (not (member MSG '("Function cancelled" "quit / exit abort")))
(princ (strcat "\n*** Program Error: " (strcase MSG) " ***"))
(princ "\n... Program Cancelled ...")
)
(while (vla-object(entlast)))

;; Add centerline
(setq ElbowArc3 (car (vlax-invoke ElbowArc1 'offset (/ TrunkSize 2.0))))
(setq ElbowLine8 (vlax-invoke Space 'addline ElbowStart ElbowPoint11))
(setq ElbowLine9 (vlax-invoke Space 'addline ElbowEnd ElbowPoint12))
(vlax-put ElbowArc3 'Layer "M-HVAC-CNTR")
(vlax-put ElbowLine8 'Layer "M-HVAC-CNTR")
(vlax-put ElbowLine9 'Layer "M-HVAC-CNTR")

;; Add "vane" to elbow
(command "_measure" (vlax-vla-object->ename ElbowLine7) "block" BlockName "y" 2.0)

;; Set properties for insulation
(vlax-put ElbowLine7 'Color 9)

(cond
((= (strcase ElbowInsul) "INSIDE")
(setq ElbowLine10
(vlax-invoke Space 'addline
(polar ElbowPoint2 ElbowDirection 1.0)
(polar (polar ElbowPoint6 ElbowDirection 1.0)(ELBOW_ADD_ANGLE TrunkDirection 180) 1.0)
)
)
(setq ElbowLine11
(vlax-invoke Space 'addline
(polar ElbowPoint3 (ELBOW_ADD_ANGLE TrunkDirection 180) 1.0)
(polar (polar ElbowPoint6 (ELBOW_ADD_ANGLE TrunkDirection 180) 1.0)(ELBOW_ADD_ANGLE ElbowDirection 180) -1.0)
)
)
(setq ElbowLine12
(vlax-invoke Space 'addline
(polar ElbowPoint1 (ELBOW_ADD_ANGLE ElbowDirection 180) 1.0)
(polar ElbowPoint7 (ELBOW_ADD_ANGLE ElbowDirection 180) 1.0)
)
)
(setq ElbowLine13
(vlax-invoke Space 'addline
(polar ElbowPoint4 TrunkDirection 1.0)
(polar ElbowPoint8 TrunkDirection 1.0)
)
)
(setq ElbowArc2 (car (vlax-invoke ElbowArc1 'offset 1)))
;; Set properties for insulation
(vlax-put ElbowLine10 'Layer "M-HVAC-INSL")
(vlax-put ElbowLine11 'Layer "M-HVAC-INSL")
(vlax-put ElbowLine12 'Layer "M-HVAC-INSL")
(vlax-put ElbowLine13 'Layer "M-HVAC-INSL")
(vlax-put ElbowArc2 'Layer "M-HVAC-INSL")
)
((= (strcase ElbowInsul) "OUTSIDE")
(setq ElbowLine14
(vlax-invoke Space 'addline
(polar ElbowPoint2 (ELBOW_ADD_ANGLE ElbowDirection 180) 1.0)
(polar (polar ElbowPoint6 (ELBOW_ADD_ANGLE ElbowDirection 180) 1.0)TrunkDirection 1.0)
)
)
(setq ElbowLine15
(vlax-invoke Space 'addline
(polar ElbowPoint3 TrunkDirection 1.0)
(polar (polar ElbowPoint6 TrunkDirection 1.0)(ELBOW_ADD_ANGLE ElbowDirection 180) 1.0)
)
)
(setq ElbowLine16
(vlax-invoke Space 'addline
(polar ElbowPoint1 ElbowDirection 1.0)
(polar ElbowPoint7 ElbowDirection 1.0)
)
)
(setq ElbowLine17
(vlax-invoke Space 'addline
(polar ElbowPoint4 (ELBOW_ADD_ANGLE TrunkDirection 180) 1.0)
(polar ElbowPoint8 (ELBOW_ADD_ANGLE TrunkDirection 180) 1.0)
)
)
(setq ElbowArc3 (car (vlax-invoke ElbowArc1 'offset -1)))
;; Set properties for insulation
(vlax-put ElbowLine14 'Layer "M-HVAC-INSL")
(vlax-put ElbowLine15 'Layer "M-HVAC-INSL")
(vlax-put ElbowLine16 'Layer "M-HVAC-INSL")
(vlax-put ElbowLine17 'Layer "M-HVAC-INSL")
(vlax-put ElbowArc3 'Layer "M-HVAC-INSL")
)
((= (strcase ElbowInsul) "BOTH")
(setq ElbowLine10
(vlax-invoke Space 'addline
(polar ElbowPoint2 ElbowDirection 1.0)
(polar (polar ElbowPoint6 ElbowDirection 1.0)(ELBOW_ADD_ANGLE TrunkDirection 180) 1.0)
)
)
(setq ElbowLine11
(vlax-invoke Space 'addline
(polar ElbowPoint3 (ELBOW_ADD_ANGLE TrunkDirection 180) 1.0)
(polar (polar ElbowPoint6 (ELBOW_ADD_ANGLE TrunkDirection 180) 1.0)(ELBOW_ADD_ANGLE ElbowDirection 180) -1.0)
)
)
(setq ElbowLine12
(vlax-invoke Space 'addline
(polar ElbowPoint1 (ELBOW_ADD_ANGLE ElbowDirection 180) 1.0)
(polar ElbowPoint7 (ELBOW_ADD_ANGLE ElbowDirection 180) 1.0)
)
)
(setq ElbowLine13
(vlax-invoke Space 'addline
(polar ElbowPoint4 TrunkDirection 1.0)
(polar ElbowPoint8 TrunkDirection 1.0)
)
)
(setq ElbowLine14
(vlax-invoke Space 'addline
(polar ElbowPoint2 (ELBOW_ADD_ANGLE ElbowDirection 180) 1.0)
(polar (polar ElbowPoint6 (ELBOW_ADD_ANGLE ElbowDirection 180) 1.0)TrunkDirection 1.0)
)
)
(setq ElbowLine15
(vlax-invoke Space 'addline
(polar ElbowPoint3 TrunkDirection 1.0)
(polar (polar ElbowPoint6 TrunkDirection 1.0)(ELBOW_ADD_ANGLE ElbowDirection 180) 1.0)
)
)
(setq ElbowLine16
(vlax-invoke Space 'addline
(polar ElbowPoint1 ElbowDirection 1.0)
(polar ElbowPoint7 ElbowDirection 1.0)
)
)
(setq ElbowLine17
(vlax-invoke Space 'addline
(polar ElbowPoint4 (ELBOW_ADD_ANGLE TrunkDirection 180) 1.0)
(polar ElbowPoint8 (ELBOW_ADD_ANGLE TrunkDirection 180) 1.0)
)
)
(setq ElbowArc2 (car (vlax-invoke ElbowArc1 'offset 1)))
(setq ElbowArc3 (car (vlax-invoke ElbowArc1 'offset -1)))
;; Set properties for insulation
(vlax-put ElbowLine10 'Layer "M-HVAC-INSL")
(vlax-put ElbowLine11 'Layer "M-HVAC-INSL")
(vlax-put ElbowLine12 'Layer "M-HVAC-INSL")
(vlax-put ElbowLine13 'Layer "M-HVAC-INSL")
(vlax-put ElbowArc2 'Layer "M-HVAC-INSL")
(vlax-put ElbowLine14 'Layer "M-HVAC-INSL")
(vlax-put ElbowLine15 'Layer "M-HVAC-INSL")
(vlax-put ElbowLine16 'Layer "M-HVAC-INSL")
(vlax-put ElbowLine17 'Layer "M-HVAC-INSL")
(vlax-put ElbowArc3 'Layer "M-HVAC-INSL")
)
)
;; Reset envireonment
(ELBOW_RESET_ENV)
)
;;;;;;;;;;;;
;;;;;;;;;;;;;;;;
(defun ELBOW_RAD (ElbowInsul / ElbowPoint1 ElbowPoint2 ElbowPoint3 ElbowPoint4 ElbowLine1 ElbowLine2 ElbowLine3
ElbowLine4 ElbowLine5 ElbowLine6 ElbowLine7 ElbowLine8 ElbowCenterLine)

;; Get elbow outer points
(setq ElbowPoint1 (polar ElbowStart ElbowDirection (/ TrunkSize 2)))
(setq ElbowPoint2 (polar ElbowStart (ELBOW_ADD_ANGLE ElbowDirection 180)(/ TrunkSize 2)))
(setq ElbowPoint3 (polar ElbowEnd TrunkDirection (/ TrunkSize 2)))
(setq ElbowPoint4 (polar ElbowEnd (ELBOW_ADD_ANGLE TrunkDirection 180)(/ TrunkSize 2)))

;; Draw Elbow
(setq ElbowLine1 (vlax-invoke Space 'addline ElbowPoint1 ElbowPoint2))
(setq ElbowLine2 (vlax-invoke Space 'addline ElbowPoint3 ElbowPoint4))
(command "_arc" ElbowStart ElbowMid ElbowEnd)
(setq ElbowCenterLine (vlax-ename->vla-object(entlast)))
(setq ElbowLine3 (car (vlax-invoke ElbowCenterLine 'offset (atof(strcat "-"(rtos(/ TrunkSize 2)5 2))))))
(setq ElbowLine4 (car (vlax-invoke ElbowCenterLine 'offset (/ TrunkSize 2))))

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

(cond
((= (strcase ElbowInsul) "INSIDE")
(setq ElbowLine5 (car (vlax-invoke ElbowLine3 'offset 1)))
(setq ElbowLine6 (car (vlax-invoke ElbowLine4 'offset -1)))
;; Set properties for insulation
(vlax-put ElbowLine5 'Layer "M-HVAC-INSL")
(vlax-put ElbowLine6 'Layer "M-HVAC-INSL")
)
((= (strcase ElbowInsul) "OUTSIDE")
(setq ElbowLine7 (car (vlax-invoke ElbowLine3 'offset -1)))
(setq ElbowLine8 (car (vlax-invoke ElbowLine4 'offset 1)))
;; Set properties for insulation
(vlax-put ElbowLine7 'Layer "M-HVAC-INSL")
(vlax-put ElbowLine8 'Layer "M-HVAC-INSL")
)
((= (strcase ElbowInsul) "BOTH")
(setq ElbowLine5 (car (vlax-invoke ElbowLine3 'offset 1)))
(setq ElbowLine6 (car (vlax-invoke ElbowLine4 'offset -1)))
(setq ElbowLine7 (car (vlax-invoke ElbowLine3 'offset -1)))
(setq ElbowLine8 (car (vlax-invoke ElbowLine4 'offset 1)))
;; Set properties for insulation
(vlax-put ElbowLine5 'Layer "M-HVAC-INSL")
(vlax-put ElbowLine6 'Layer "M-HVAC-INSL")
(vlax-put ElbowLine7 'Layer "M-HVAC-INSL")
(vlax-put ElbowLine8 'Layer "M-HVAC-INSL")
)
)
;; Reset envireonment
(ELBOW_RESET_ENV)
)
;;; ------------ CREATE VANE BLOCK SUB - DOES NOT INSERT BLOCK
(defun ELBOW_VANE_BLOCK (/)

(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 ELBOW_CREATE_LAYER (Layer Descpition Linetype Thickness Color Plot / TmpList VLA-Obj)

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

(setq SinA (sin (ELBOW_DTR SinAngle1)))
(setq SinB (sin (ELBOW_DTR SinAngle2)))
(setq SideLength (ELBOW_RND (/ (* Side1 SinB) SinA)4))
Sidelength
)
;;; ------------ ADD / SUBTRACT ANGLE SUB ROUTINES
(defun ELBOW_ADD_ANGLE (Radians AddAngle / )

(ELBOW_DTR(+ (ELBOW_RTD Radians) AddAngle))
)
(defun ELBOW_SUBTRACT_ANGLE (Radians AddAngle / )

(ELBOW_DTR(- (ELBOW_RTD Radians) AddAngle))
)
;;; ------------ GET RADIUS OF ARC (CHORD LENGTH & CHORD HEIGHT KNOWN)
(defun ELBOW_GET_RADIUS (ChordLength ChordHeight / Radius)

(setq Radius (/(+(expt ChordHeight 2)(/ (expt ChordLength 2)4))(* ChordHeight 2)))
Radius
)
(defun ELBOW_GET_HEIGHT (Chord Radius / Height)

(setq Height (- Radius (sqrt(-(expt Radius 2)(expt(/ Chord 2)2)))))
Height
)
;;; ------------ GET PERPENDICULAR POINT
(defun ELBOW_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
)
;;; ------------ RESET SYSEM VARIABLES
(defun ELBOW_RESET_ENV (/)

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

Advertisements