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

Advertisements