home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Black Box 4
/
BlackBox.cdr
/
autocad
/
may91.arj
/
NATWIN.LSP
< prev
next >
Wrap
Text File
|
1991-05-13
|
8KB
|
237 lines
; NATWIN.LSP [Article Figure 4] (c)1991, Barry Bowen
; *********************************************************|
; NATWIN.LSP
; Copyright (c) Barry R. Bowen 1991
; ---------------------------------------------------------|
; Variables:
; BN = Block name of window model
; FILE = Data file
; GRIL = Grille option type [Global]
; HUWD = Half the window unit length
; HUHT = Half the window unit height
; LINE = One line in the data file
; S1 = Sash opening width
; S2 = Sash opening height
; S3 = Divided grille type
; S4 = Diamond grille type
; SIZE = Unit size
; UNITWD = Unit width
; UNITHT = Unit height
; WINVW = View option [Global]
;
; Sample Call: (NATWIN "2832" 1 "3-2DH.DAT")
; where "2832" is the model number
; 1 is the number of windows and
; "3-2DH.DAT" is the data file.
; ---------------------------------------------------------|
(defun NATWIN (SIZE QTY DATA / BN BM CL EN EN1 FILE HUWD
HUHT LINE S1 S2 S3 S4 SIZE UNITWD UNITHT)
(V3)
(if (= WINVW nil) (progn
(initget 1 "PL EL")
(setq WINVW (getkword "\n<PL>an/<EL>evation: "))))
(if (/= WINVW "PL")
(setq MPT (getpoint "\nInsertion Point: ")))
(setq EN (entlast)
FILE (open DATA "r")
SL (strlen SIZE)
LINE (read-line FILE))
(while (and LINE (/= SIZE (substr LINE 1 SL)))
(setq LINE (read-line FILE)))
(close FILE)
(if (not (member LINE '(nil "")))
(if (= SIZE (substr LINE 1 SL))
(progn
(WINDAT)
(setq UNITWD (+ S1 4.0)
UNITHT (+ S2 4.5)
HUWD (/ UNITWD 2.0)
HUHT (/ UNITHT 2.0))
(if (= WINVW "EL") (WINEL) (WINPL))
(RL)
) )
(prompt "\nRequested Size Not In Data File!")
) (princ)
(V4)
)
; ----------------------- WINDAT --------------------------|
; Get Data from required file
(defun WINDAT ()
(setq BN (substr LINE 1 4)
BN (strcat WTYP "-" BN GRIL "-" WINVW)
S1 (atof (substr LINE 11 10))
S2 (atof (substr LINE 21 10))
S3 (substr LINE 31 7)
S4 (substr LINE 41 8)))
; ------------------------ WINEL --------------------------|
; Draw Window in Elevation view
(defun WINEL (/ PT1 PT2 PT2A PT3 PT4 PT5 PT5A PT6 PT7 PT8
PT9 LWINH LWINW)
(if (= (tblsearch "block" BN) nil)
(progn
(prompt "\nBuilding Window Block......Please Wait ")
(LS "A-GLAZ-ELEV" "2" "")
(setq PT1 (polar MPT pi HUWD)
PT2 (polar PT1 (D90) 1.25)
PT3 (polar PT2 0 UNITWD)
PT2A (polar PT3 pi 0.75)
PT4 (polar PT2 0 0.75)
PT5 (polar (polar PT4 0 1.25) (D90) 1.25)
PT5A (polar PT5 0 S1)
PT6 (polar (polar PT5 0 1.0) (D90) 2.0)
PT7 (polar PT5 (D90) (/ S2 2.0))
PT8 (polar PT7 0 S1)
PT9 (polar (polar PT7 0 1.0) (D90) 1.0)
LWINW (- S1 2.0)
LWINH (- (/ S2 2.0) 2.0)
)
(command "insert" "rectang" PT1 UNITWD UNITHT 0
"insert" "1DN" PT4 (- UNITWD 1.5) (- UNITHT 2.0) 0
"insert" "rectang" PT5 S1 S2 0
"insert" "1UP" PT6 LWINW LWINH 0
"insert" "rectang" PT9 LWINW LWINH 0
"line" PT2 PT3 ""
"line" PT4 PT5 ""
"line" PT2A PT5A ""
"line" PT7 PT8 "")
(if (/= GRIL "NG") (LS "A-GLAZ-GRIL" "1" ""))
(cond
((= GRIL "G1") (command "insert" S3 PT6 LWINW LWINH 0
"insert" S3 PT9 LWINW LWINH 0))
((= GRIL "G2") (command "insert" S4 PT6 LWINW LWINH 0
"insert" S4 PT9 LWINW LWINH 0))
)
(MKSET)
(command "block" BN MPT SS1 ""
"insert" BN MPT 1 1 0)
) ;End Progn
(command "insert" BN MPT 1 1 0)
) ;End IF
(cond
((= QTY 2)
(command "move" (entlast) "" MPT (polar MPT 0 HUWD)
"copy" (entlast) "" MPT (polar MPT pi UNITWD)))
((= QTY 3) (setq EN (entlast))
(command "copy" EN "" PT2 PT3
"copy" EN "" PT3 PT2))
) ;End Cond
)
; ------------------------ WINPL --------------------------|
; Install window in Plan View
(defun WINPL (/ ANG ANG1 HLGTH LGTH PT PT1 PT2 PT3 PT4 WPT)
(prompt "\nSelect Outside Wall Line For Midpoint: ")
(setq EN (entsel)
PT (cadr EN)
MPT (osnap PT "mid")
EN1 (car EN)
PT1 (cdr (assoc 10 (entget EN1)))
PT2 (cdr (assoc 11 (entget EN1)))
ANG (angle PT1 PT2))
(command "osnap" "per")
(setq WPT (getpoint MPT "\nSelect Inside Wall: "))
(command "osnap" "none")
(setq HLGTH HUWD LGTH UNITWD)
(cond
((= QTY 2) (setq HLGTH UNITWD LGTH (* 2 UNITWD)))
((= QTY 3) (setq HLGTH (* 1.5 UNITWD) LGTH (* 3 UNITWD)))
)
(setq ANG1 (angle MPT WPT)
PT1 (polar MPT (A180) HLGTH)
PT2 (polar PT1 ANG LGTH)
PT3 (polar PT1 ANG1 4.0)
PT4 (polar PT2 ANG1 4.0))
(if (= (tblsearch "block" BN) nil)
(progn
(LS "A-GLAZ" "2" "")
(command "insert" "WINPL" MPT 1 UNITWD 0
"block" BN MPT (entlast) "")
) )
(LS "A-WALL" "3" "")
(command "break" PT1 PT2
"break" PT3 PT4
"line" PT1 PT3 ""
"line" PT2 PT4 "")
(LS "WNDS" "2" "")
(cond
((= QTY 2)
(command "insert"
BN (polar MPT ANG HUWD) 1 1 (angtos ANG1)
"insert" BN (polar MPT (A180) HUWD) 1 1 (angtos ANG1)))
((= QTY 3) (command "insert" BN MPT 1 1 (angtos ANG1))
(command "insert"
BN (polar MPT ANG UNITWD) 1 1 (angtos ANG1)
"insert" BN (polar MPT (A180) UNITWD) 1 1 (angtos ANG1)))
(T (command "insert" BN MPT 1 1 (angtos ANG1)))
)
)
; ------------------------ V3.LSP -------------------------|
(defun V3 ()
(setq BM (getvar "blipmode") OS (getvar "osmode"))
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(command "undo" "group" "osnap" "none"))
; ------------------------ V4.LSP -------------------------|
(defun V4 (/ BA)
(setvar "blipmode" BM)
(setvar "osmode" OS)
(command "undo" "end")
(prompt "\n")
(setq BA "Program Completed. . . . ."))
; ------------------------- LS ----------------------------|
; Layer search command for creating new layers.
(defun LS (NLAY CLR LT / LAY)
(setq CL (getvar "clayer"))
(setq LAY (tblsearch "layer" NLAY))
(if (not LAY)
(command "layer" "m" NLAY "c" CLR "" "lt" LT "" "");True
(progn
(setq FRZ (cdr (assoc 70 LAY)))
(if (= FRZ 65)
(progn
(command "layer" "t" NLAY "")
(command "layer" "s" NLAY "")
)
(command "layer" "s" NLAY "") ;False
)) ) )
; -------------------------- RL ---------------------------|
; Resets the previous layer to the current layer.
(defun RL () (command "layer" "s" CL ""))
; ------------------------ MKSET --------------------------|
; Make a selection-set of all entities
(defun MKSET ()
(setq SS1 (ssadd) EN1 (entnext EN))
(while EN
(setq SS1 (ssadd EN1 SS1)
EN1 (entnext EN)
EN EN1)))
; ------------------------ D90 ----------------------------|
(defun D90 () (* pi 0.5))
; ------------------------ A180 ---------------------------|
(defun A180 () (+ ANG pi))
; ---------------------- *ERROR* --------------------------|
(defun *error* (MSG)
(princ "error: ")
(princ MSG)
(foreach SVAR '("menuecho" "blipmode") (setvar SVAR 1))
(foreach SVAR '("cmdecho" "snapang" "highlight")
(setvar SVAR 0))
(princ))
(prompt "\nWindow Program Loaded.............")
(prompt "\nCopyright (c) Barry R. Bowen 1991 ")
(princ)