;;; ------------------------------------------------------------------------
;;; CreateOffset.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:OFF (/)(OFFSET_START))
;;; ------------ MAIN FUNCTION
(defun OFFSET_START (/ *error* OldClayer OldCmdEcho OldOsmode OffsetStyle OffsetInsul TrunkLine EntList
OffsetLayer LineStart LineEnd LineAngle TrunkSize OffsetStart OffsetLength SidePoint TrunkDirection ArwPoint TextPoint)

;;; 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 ( TrunkDirection (DUCT_DTR 90.0))(< TrunkDirection (DUCT_DTR 270.0)))
(setq TextAngle (DUCT_ADD_ANGLE TrunkDirection 180.0))
(setq TextAngle TrunkDirection)
)

;; Setup text entity list
(setq TextEntList
(list
'(0 . "TEXT") ;***
(cons 1 OffsetStyle) ;*** Text String
'(6 . "BYLAYER") ;*** Linetype
'(7 . "STANDARD") ;*** Text Style
'(8 . "M-HVAC-IDEN") ;*** Layer Name
(cons 10 TextPoint) ;*** Start Point
(cons 11 TextPoint) ;*** End Point
'(39 . 0.0)
'(40 . 4.0) ;*** Height
'(41 . 1.0)
(cons 50 TextAngle) ;*** Text rotation angle
'(51 . 0.0)
'(62 . 256)
'(71 . 0)
'(72 . 1)
'(73 . 2)
)
)
(entmake TextEntList)
)
;;; ------------ CREATE ARROW BLOCK SUB - DOES NOT INSERT BLOCK
(defun OFFSET_CREATE_ARROW (/ OldLunits OldLuPrec BlockName)

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

(setq BlockName "ARROW")

(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 "LINE")
(cons 10 (list 0.0 0.0 0.0))
(cons 11 (list -2.0 2.0 0.0))
(cons 8 "0")
(cons 62 256)
)
)
(entmake
(list
(cons 0 "LINE")
(cons 10 (list -2.0 2.0 0.0))
(cons 11 (list -2.0 -2.0 0.0))
(cons 8 "0")
(cons 62 256)
)
)
(entmake
(list
(cons 0 "LINE")
(cons 10 (list -2.0 -2.0 0.0))
(cons 11 (list 0.0 0.0 0.0))
(cons 8 "0")
(cons 62 256)
)
)
(entmake
(list
(cons 0 "HATCH")
(cons 100 "AcDbEntity")
(cons 8 "0")
(cons 100 "AcDbHatch")
(cons 10 (list 0.0 0.0 0.0))
(cons 210 (list 0.0 0.0 1.0))
(cons 2 "NET3")
(cons 70 0)
(cons 71 0)
(cons 91 1)
(cons 92 7)
(cons 72 0)
(cons 73 1)
(cons 93 3)
(cons 10 (list -2.0 2.0 0.0))
(cons 10 (list -2.0 -2.0 0.0))
(cons 10 (list 0.0 0.0 0.0))
(cons 97 0)
(cons 75 0)
(cons 76 1)
(cons 52 0.0)
(cons 41 1.0)
(cons 77 0)
(cons 78 3)
(cons 53 0.0)
(cons 43 0.0)
(cons 44 0.0)
(cons 45 0.0)
(cons 46 0.125000000000000)
(cons 79 0)
(cons 53 1.047197551196598)
(cons 43 0.0)
(cons 44 0.0)
(cons 45 -0.108253175473055)
(cons 46 0.062500000000000)
(cons 79 0)
(cons 53 2.094395102393195)
(cons 43 0.0)
(cons 44 0.0)
(cons 45 -0.108253175473055)
(cons 46 -0.062500000000000)
(cons 79 0)
(cons 47 0.006231430709948)
(cons 98 1)
(cons 10 (list -1.220062812177048 0.400077266899984 0.0))
)
)
(entmake
'((0 . "ENDBLK"))
)
)
(princ "Arrow block already exsists")
)
(setvar "LUNITS" OldLunits)
(setvar "LUPREC" OldLuPrec)
BlockName
)
;;; ------------ INSERT ARROW BLOCK SUB
(defun OFFSET_INSERT_ARROW (InsertPoint InsertLayer /)

(entmake
(list
(cons 0 "INSERT")
(cons 8 InsertLayer)
(cons 50 TrunkDirection)
(cons 66 1)
(cons 2 "ARROW")
(cons 10 InsertPoint)
)
)
(entmake
(list
(cons 0 "SEQEND")
(cons 8 InsertLayer)
)
)
)
;;; ------------ LAYER CREATION ROUINE
(defun OFFSET_CREATE_LAYER (Layer Descpition Linetype Thickness Color Plot / TmpList VLA-Obj)

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

(OFFSET_DTR(+ (OFFSET_RTD Radians) AddAngle))
)
;;; ------------ GET PERPENDICULAR POINT
(defun OFFSET_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
)
;; ------------ DEGREES / RADIANS SUB ROUTINES
(defun OFFSET_DTR (NumberOfDegrees)
(* pi (/ NumberOfDegrees 180.0))
)
(defun OFFSET_RTD (NumberOfRadians)
(* 180.0 (/ NumberOfRadians pi))
)
;;; ------------ RESET SYSEM VARIABLES
(defun OFFSET_RESET_ENV (/)

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

Advertisements