;;; ------------------------------------------------------------------------
;;; CreateSection.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:SECT (/) (SECTION_START))

;;; ------------ MAIN FUNCTION
(defun SECTION_START ( / *error* Angle+90 Angle-90 ActiveDoc OldClayer OldCmdEcho Space
SectStyle
SectShape
SectWidth
SectLength
SectAlign
SectType
SectInsul
InsPoint
InsAngle
)

;;; 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)
)
(princ)
)
;;; End Error Handler ---------------------------------------------------
(SECTION_SET_ENV)
)
;;; ------------ SET ENVIROMENT BEFORE LAUNCH
(defun SECTION_SET_ENV(/)

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

(setvar "CMDECHO" 0)

(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)
)
)
;; Run duct
(SECTION_RUN)
)
;;; ------------ GET VARIABLES FOR DIFFUSER CREATION
(defun SECTION_RUN (/)

;; Get section style
(initget "Supply s S Return r R Exhaust e E Dust d D")
(if(not(setq SectStyle (getkword "Enter section style: (Supply/Return/Exhaust/Dust) ")))
(setq SectStyle "Supply")
)

;; Get section shape
(initget "Square s S Round r R")
(if (not(setq SectShape (getkword "Enter section shape: (Square/Round) ")))
(setq SectShape "Square")
)

(if (= (strcase SectShape) "SQUARE")
(progn
;; If square
(setq SectWidth (getreal "\n Enter section width: (6\")"))
(if (not SectWidth)
(setq SectWidth 6.0)
)
(if (< SectWidth 6.0)
(setq SectWidth (getreal "\n Enter section width: \n -Must be greater than 6\"- "))
)
(setq SectLength (getreal "\n Enter section length: (6\")"))
(if (not SectLength)
(setq SectLength 6.0)
)
(if (< SectLength 6.0)
(setq SectLength (getreal "\n Enter section length: \n -Must be greater than 6\"- "))
)
)
(progn
;; If round
(setq SectWidth (getreal "\n Enter section diameter: (12\")"))
(if (not SectWidth)
(setq SectWidth 12.0)
)
(if (< SectWidth 4.0)
(setq SectWidth (getreal "\n Enter diffuser diameter: \n -Must be greater than 4\"- "))
)
)
)
;; Get section alignment
(initget 1 "Center c C Top t T Bottom b B")
(if (not(setq SectAlign (getkword "\n Enter duct alignment: (Center/Top/Bottom) ")))
(setq SectAlign "Center")
)

;; Get section type
(initget "Up u U Down d D")
(if (not(setq SectType (getkword "\n Enter section type: (Up/Down) ")))
(setq SectType "Up")
)

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

;; Get insertion point
(while(null(setq InsPoint (getpoint "\n Define insertion point: ")))
(princ "-Point not defined-")
)

;; Get insertion angle
(setq InsAngle (getangle InsPoint "\n Define section direction: "))

;; Setup angles
(setq Angle+90 (+ InsAngle (SECTION_DTR 90)))
(setq Angle-90 (- InsAngle (SECTION_DTR 90)))

(if(= (strcase SectShape) "SQUARE")
(SECTION_CREATE_SQUARE InsPoint InsAngle SectWidth SectLength SectAlign SectType)
(SECTION_CREATE_ROUND InsPoint SectWidth SectType)
)
(princ)
)
;;; ------------ LAYER CREATION ROUINE
(defun SECTION_CREATE_LAYER (Layer Descpition Linetype Thickness Color Plot / TmpList VLA-Obj)

;; Check to see if linetype exsists
(if (= (tblsearch "ltype" Linetype) nil)
(if (SECTION_CHECK_LINETYPE (findfile "acad.lin") Linetype)
(command "linetype" "load" Linetype "acad.lin" "")
(setq Linetype "Continuous")
)
)
;;; ------------ CREATE A LIST FOR ENTMAKE
(setq TmpList
'((0 . "LAYER")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbLayerTableRecord")
(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 SECTION_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(SECTION_STRING_TO_LIST CurrentLine ","))2))
(if (= (strcase Linetype) LinetypeName)
(setq Result T)
)
)
)
)
(close OpenFile)
Result
)
;;; ------------ STRING TO LIST SUB ROUTINE
(defun SECTION_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))
)
;;; ------------ CREATE LAY-IN SQUARE DIFFUSER
(defun SECTION_CREATE_SQUARE(InsPoint InsAngle SectWidth SectLength SectAlign SectType /
SectPoint1
SectPoint2
SectPoint3
SectPoint4
SectCenter
SectPointList
SectPoints
Stop
Counter
TempPoint
vlaSection
VlaSectLine1
VlaSectLine2
SectInsulIn
SectInsulOut
)

(setvar "CLAYER" "0")

;; Set up creation points
(cond
((= (strcase SectAlign) "CENTER")
(setq SectPoint1 (polar InsPoint Angle+90 (/ SectWidth 2)))
(setq SectPoint2 (polar InsPoint Angle-90 (/ SectWidth 2)))
(setq SectPoint3 (polar SectPoint1 InsAngle SectLength))
(setq SectPoint4 (polar SectPoint2 InsAngle SectLength))
(setq SectCenter (polar SectPoint1 (angle SectPoint1 SectPoint4) (/(distance SectPoint1 SectPoint4)2)))
)
((= (strcase SectAlign) "TOP")
(setq SectPoint1 InsPoint)
(setq SectPoint2 (polar SectPoint1 Angle+90 SectWidth))
(setq SectPoint3 (polar SectPoint1 InsAngle SectLength))
(setq SectPoint4 (polar SectPoint2 InsAngle SectLength))
(setq SectCenter (polar SectPoint1 (angle SectPoint1 SectPoint4) (/(distance SectPoint1 SectPoint4)2)))
)
((= (strcase SectAlign) "BOTTOM")
(setq SectPoint1 InsPoint)
(setq SectPoint2 (polar SectPoint1 Angle-90 SectWidth))
(setq SectPoint3 (polar SectPoint1 InsAngle SectLength))
(setq SectPoint4 (polar SectPoint2 InsAngle SectLength))
(setq SectCenter (polar SectPoint1 (angle SectPoint1 SectPoint4) (/(distance SectPoint1 SectPoint4)2)))
)
)
(setq SectPointList (list SectPoint1 SectPoint3 SectPoint4 SectPoint2))

;; Create list of 2D point from list of points
(setq SectPoints nil)
(setq Stop (length SectPointList))
(setq Counter 0)
(while (/= Counter Stop)
(setq TempPoint(reverse(cdr(reverse (nth Counter SectPointList)))))
(setq SectPoints (append TempPoint SectPoints))
(setq Counter (1+ Counter))
)

;; Draw the outside of the section
(setq vlaSection (vla-addLightweightPolyline Space
(vlax-safearray-fill
(vlax-make-safearray vlax-vbDouble (cons 0 (- (length SectPoints) 1)))
SectPoints))
)
;; Close the polyline
(vla-put-closed vlaSection :vlax-true)

(cond
((= (strcase SectStyle) "SUPPLY")

;; Setup layer
(SECTION_CREATE_LAYER "M-HVAC-SUPP" "Mechanical Plan - Supply ductwork" "Continuous" "35" "133" "1")

;; Create line for supply
(setq VlaSectLine1 (vlax-invoke space 'AddLine SectPoint1 SectPoint4))
(setq VlaSectLine2 (vlax-invoke space 'AddLine SectPoint2 SectPoint3))

;; Set layer properties
(vlax-put vlaSection 'Layer "M-HVAC-SUPP")
(vlax-put VlaSectLine1 'Layer "M-HVAC-SUPP")
(vlax-put VlaSectLine2 'Layer "M-HVAC-SUPP")

;; Set linetype properties
(if (= (strcase SectType) "UP")
(progn
(vlax-put vlaSection 'Linetype "BYLAYER")
(vlax-put VlaSectLine1 'Linetype "BYLAYER")
(vlax-put VlaSectLine2 'Linetype "BYLAYER")
)
(progn
(vlax-put vlaSection 'Linetype "HIDDEN2")
(vlax-put VlaSectLine1 'Linetype "HIDDEN2")
(vlax-put VlaSectLine2 'Linetype "HIDDEN2")
)
)
)
((= (strcase SectStyle)"RETURN")

;; Setup layer
(SECTION_CREATE_LAYER "M-HVAC-RETN" "Mechanical Plan - Return ductwork" "Continuous" "35" "23" "1")

;; Create line for return
(setq VlaSectLine1 (vlax-invoke space 'AddLine SectPoint1 SectPoint4))

;; Set layer properties
(vlax-put vlaSection 'Layer "M-HVAC-RETN")
(vlax-put VlaSectLine1 'Layer "M-HVAC-RETN")

;; Set linetype properties
(if (= (strcase SectType) "UP")
(progn
(vlax-put vlaSection 'Linetype "BYLAYER")
(vlax-put VlaSectLine1 'Linetype "BYLAYER")
)
(progn
(vlax-put vlaSection 'Linetype "HIDDEN2")
(vlax-put VlaSectLine1 'Linetype "HIDDEN2")
)
)
)
((= (strcase SectStyle)"EXHAUST")

;; Setup layer
(SECTION_CREATE_LAYER "M-HVAC-EXHS" "Mechanical Plan - Exhaust ductwork" "Continuous" "35" "83" "1")

;; Create line for exhaust
(setq VlaSectLine1 (vlax-invoke space 'AddLine SectPoint1 SectPoint4))
(setq VlaSectLine2 (vlax-invoke space 'AddLine SectPoint2 SectCenter))

;; Set layer properties
(vlax-put vlaSection 'Layer "M-HVAC-EXHS")
(vlax-put VlaSectLine1 'Layer "M-HVAC-EXHS")
(vlax-put VlaSectLine2 'Layer "M-HVAC-EXHS")

;; Set linetype properties
(if (= (strcase SectType) "UP")
(progn
(vlax-put vlaSection 'Linetype "BYLAYER")
(vlax-put VlaSectLine1 'Linetype "BYLAYER")
(vlax-put VlaSectLine2 'Linetype "BYLAYER")
)
(progn
(vlax-put vlaSection 'Linetype "HIDDEN2")
(vlax-put VlaSectLine1 'Linetype "HIDDEN2")
(vlax-put VlaSectLine2 'Linetype "HIDDEN2")
)
)
)
((= (strcase SectStyle)"DUST")

;; Setup layer
(SECTION_CREATE_LAYER "M-HVAC-DUST" "Mechanical Plan - Dust and fume collection ductwork" "Continuous" "35" "203" "1")

;; Create line for exhaust
(setq VlaSectLine1 (vlax-invoke space 'AddLine SectPoint1 SectCenter))
(setq VlaSectLine2 (vlax-invoke space 'AddLine SectPoint3 SectCenter))

;; Set layer properties
(vlax-put vlaSection 'Layer "M-HVAC-DUST")
(vlax-put VlaSectLine1 'Layer "M-HVAC-DUST")
(vlax-put VlaSectLine2 'Layer "M-HVAC-DUST")

;; Set linetype properties
(if (= (strcase SectType) "UP")
(progn
(vlax-put vlaSection 'Linetype "BYLAYER")
(vlax-put VlaSectLine1 'Linetype "BYLAYER")
(vlax-put VlaSectLine2 'Linetype "BYLAYER")
)
(progn
(vlax-put vlaSection 'Linetype "HIDDEN2")
(vlax-put VlaSectLine1 'Linetype "HIDDEN2")
(vlax-put VlaSectLine2 'Linetype "HIDDEN2")
)
)
)
)

;; Setup layer for centerline
(SECTION_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")

;; Create insulation
(cond
((= (strcase SectInsul) "INSIDE")
;; Offset the polyline for insulation
(setq SectInsulIn (car(vlax-invoke vlaSection 'Offset -1)))
(vlax-put SectInsulIn 'Layer "M-HVAC-INSL")
(vlax-put SectInsulIn 'Linetype "BYLAYER")
)
((= (strcase SectInsul) "OUTSIDE")
;; Offset the polyline for insulation
(setq SectInsulOut (car(vlax-invoke vlaSection 'Offset 1)))
(vlax-put SectInsulOut 'Layer "M-HVAC-INSL")
(vlax-put SectInsulOut 'Linetype "BYLAYER")
)
((= (strcase SectInsul) "BOTH")
;; Offset the polyline for insulation
(setq SectInsulIn (car(vlax-invoke vlaSection 'Offset -1)))
(setq SectInsulOut (car(vlax-invoke vlaSection 'Offset 1)))
(vlax-put SectInsulIn 'Layer "M-HVAC-INSL")
(vlax-put SectInsulIn 'Linetype "BYLAYER")
(vlax-put SectInsulOut 'Layer "M-HVAC-INSL")
(vlax-put SectInsulOut 'Linetype "BYLAYER")
)
)
(SECTION_RESET_ENV)
)
;;; ------------ CREATE LAY-IN SQUARE ROUND
(defun SECTION_CREATE_ROUND(InsPoint SectWidth SectType /
vlaSection
VlaLine
SectPoint1
SectCenter
SectPointList
SuppPoints
RtrnPoints
ExhsPoints
DustPoints
SectInsulIn
SectInsulOut
)

(setvar "CLAYER" "0")

;; Set up creation points
(cond
((= (strcase SectAlign) "CENTER")
(setq SectPoint1 InsPoint)
(setq SectCenter SectPoint1)
(setq SectPointList (SECTION_GET_POINTS SectPoint1 (SECTION_INSCRIBE_SQUARE SectWidth)(SECTION_INSCRIBE_SQUARE SectWidth)))
)
((= (strcase SectAlign) "TOP")
(setq SectPoint1 (polar InsPoint Angle-90 (/ Sectwidth 2)))
(setq SectCenter SectPoint1)
(setq SectPointList (SECTION_GET_POINTS SectPoint1 (SECTION_INSCRIBE_SQUARE SectWidth)(SECTION_INSCRIBE_SQUARE SectWidth)))
)
((= (strcase SectAlign) "BOTTOM")
(setq SectPoint1 (polar InsPoint Angle+90 (/ Sectwidth 2)))
(setq SectCenter SectPoint1)
(setq SectPointList (SECTION_GET_POINTS SectPoint1 (SECTION_INSCRIBE_SQUARE SectWidth)(SECTION_INSCRIBE_SQUARE SectWidth)))
)
)

;; Draw the outside of the section
(setq vlaSection (vlax-invoke space 'AddCircle SectPoint1 (/ SectWidth 2)))

;; Draw lines to show type os section
(cond
((= (strcase SectStyle)"SUPPLY")

;; Setup layer
(SECTION_CREATE_LAYER "M-HVAC-SUPP" "Mechanical Plan - Supply ductwork" "Continuous" "35" "133" "1")

;; Set properties
(vlax-put vlaSection 'Layer "M-HVAC-SUPP")

;; Set poits for section type
(setq SuppPoints (list (nth 0 SectPointList)(nth 1 SectPointList)(nth 2 SectPointList)(nth 3 SectPointList)))

(if (= (strcase SectType) "UP")
;; Up duct
(foreach X SuppPoints
(setq VlaLine (vlax-invoke space 'AddLine X SectCenter))

;; Set properties
(vlax-put VlaLine 'Layer "M-HVAC-SUPP")
(vlax-put VlaLine 'Linetype "BYLAYER")
)
;; Down duct
(foreach X SuppPoints
(setq VlaLine (vlax-invoke space 'AddLine X SectCenter))

;; Set properties
(vlax-put VlaLine 'Layer "M-HVAC-SUPP")
(vlax-put VlaLine 'Linetype "HIDDEN2")

(vlax-put vlaSection 'Linetype "HIDDEN2")
)
)
)
((= (strcase SectStyle) "RETURN")

;; Setup layer
(SECTION_CREATE_LAYER "M-HVAC-RETN" "Mechanical Plan - Return ductwork" "Continuous" "35" "23" "1")

;; Set properties
(vlax-put vlaSection 'Layer "M-HVAC-RETN")

;; Set poits for section type
(setq RtrnPoints (list (nth 0 SectPointList)(nth 2 SectPointList)))

(if (= (strcase SectType) "UP")
;; Up duct
(foreach X RtrnPoints
(setq VlaLine (vlax-invoke space 'AddLine X SectCenter))

;; Set properties
(vlax-put VlaLine 'Layer "M-HVAC-RETN")
(vlax-put VlaLine 'Linetype "BYLAYER")
)
;; Down duct
(foreach X RtrnPoints
(setq VlaLine (vlax-invoke space 'AddLine X SectCenter))

;; Set properties
(vlax-put VlaLine 'Layer "M-HVAC-RETN")
(vlax-put VlaLine 'Linetype "HIDDEN2")

(vlax-put vlaSection 'Linetype "HIDDEN2")
)
)
)
((= (strcase SectStyle)"EXHAUST")

;; Setup layer
(SECTION_CREATE_LAYER "M-HVAC-EXHS" "Mechanical Plan - Exhaust ductwork" "Continuous" "35" "83" "1")

;; Set properties
(vlax-put vlaSection 'Layer "M-HVAC-EXHS")

;; Set poits for section type
(setq ExhsPoints (list (nth 0 SectPointList)(nth 1 SectPointList)(nth 2 SectPointList)))

(if (= (strcase SectType) "UP")
;; Up duct
(foreach X ExhsPoints
(setq VlaLine (vlax-invoke space 'AddLine X SectCenter))

;; Set properties
(vlax-put VlaLine 'Layer "M-HVAC-EXHS")
(vlax-put VlaLine 'Linetype "BYLAYER")
)
;; Down duct
(foreach X ExhsPoints
(setq VlaLine (vlax-invoke space 'AddLine X SectCenter))

;; Set properties
(vlax-put VlaLine 'Layer "M-HVAC-EXHS")
(vlax-put VlaLine 'Linetype "HIDDEN2")

(vlax-put vlaSection 'Linetype "HIDDEN2")
)
)
)
((= (strcase SectStyle) "DUST")

;; Setup layer
(SECTION_CREATE_LAYER "M-HVAC-DUST" "Mechanical Plan - Dust and fume collection ductwork" "Continuous" "35" "203" "1")

;; Set properties
(vlax-put vlaSection 'Layer "M-HVAC-DUST")

;; Set poits for section type
(setq DustPoints (list (nth 0 SectPointList)(nth 1 SectPointList)))

(if (= (strcase SectType) "UP")
;; Up duct
(foreach X DustPoints
(setq VlaLine (vlax-invoke space 'AddLine X SectCenter))

;; Set properties
(vlax-put VlaLine 'Layer "M-HVAC-DUST")
(vlax-put VlaLine 'Linetype "BYLAYER")
)
;; Down duct
(foreach X DustPoints
(setq VlaLine (vlax-invoke space 'AddLine X SectCenter))

;; Set properties
(vlax-put VlaLine 'Layer "M-HVAC-DUST")
(vlax-put VlaLine 'Linetype "HIDDEN2")

(vlax-put vlaSection 'Linetype "HIDDEN2")
)
)
)
)
;; Setup layer for centerline
(SECTION_CREATE_LAYER "M-HVAC-INSL" "Mechanical Plan - Ductwork Insulation" "HIDDEN2" "15" "201" "1")

;; Create insulation
(cond
((= (strcase SectInsul) "INSIDE")
;; Offset the polyline for insulation
(setq SectInsulIn (car(vlax-invoke vlaSection 'Offset -1)))
(vlax-put SectInsulIn 'Layer "M-HVAC-INSL")
(vlax-put SectInsulIn 'Linetype "BYLAYER")
)
((= (strcase SectInsul) "OUTSIDE")
;; Offset the polyline for insulation
(setq SectInsulOut (car(vlax-invoke vlaSection 'Offset 1)))
(vlax-put SectInsulOut 'Layer "M-HVAC-INSL")
(vlax-put SectInsulOut 'Linetype "BYLAYER")
)
((= (strcase SectInsul) "BOTH")
;; Offset the polyline for insulation
(setq SectInsulIn (car(vlax-invoke vlaSection 'Offset -1)))
(setq SectInsulOut (car(vlax-invoke vlaSection 'Offset 1)))
(vlax-put SectInsulIn 'Layer "M-HVAC-INSL")
(vlax-put SectInsulIn 'Linetype "BYLAYER")
(vlax-put SectInsulOut 'Layer "M-HVAC-INSL")
(vlax-put SectInsulOut 'Linetype "BYLAYER")
)
)

(SECTION_RESET_ENV)
)
;;; ------------ DEGREES TO RADIANS SUB ROUTINE
(defun SECTION_DTR (NumberOfDegrees)
(* pi (/ NumberOfDegrees 180.0))
)
;;; ------------ GET CORNER POINTS FROM CENTER POINT
(defun SECTION_GET_POINTS (InsPoint Width Length / DLength DWidth )

(setq DLength (* 0.5 Width))
(setq DWidth (* 0.5 Length))
(setq InsPoint (trans InsPoint 1 0))
(setq DPoint1 (list (- (car InsPoint) DLength)(- (cadr InsPoint) DWidth)(caddr InsPoint)))
(setq DPoint2 (list (+ (car InsPoint) DLength)(+ (cadr InsPoint) DWidth)(caddr InsPoint)))
(setq DPoint3 (list (car DPoint2)(cadr DPoint1)(caddr InsPoint)))
(setq DPoint4 (list (car DPoint1)(cadr DPoint2)(caddr InsPoint)))
(list DPoint1 DPoint3 DPoint2 DPoint4)
)
;;; ------------ INSCRIBE A SQUARE IN A CIRCLE
(defun SECTION_INSCRIBE_SQUARE (Diameter / A SinA SinB Sidelength)

(setq A Diameter)
(setq SinA (sin (SECTION_DTR 90)))
(setq SinB (sin (SECTION_DTR 45)))
(setq SideLength (RND (/ (* A SinB) SinA)4))
Sidelength
)
;;; ------------ RESET SYSEM VARIABLES
(defun SECTION_RESET_ENV (/)

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

Advertisements