home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / autocad / may91.arj / NATWIN.LSP < prev    next >
Text File  |  1991-05-13  |  8KB  |  237 lines
  1. ; NATWIN.LSP   [Article Figure 4]   (c)1991, Barry Bowen
  2.  
  3. ; *********************************************************|
  4. ; NATWIN.LSP
  5. ; Copyright (c) Barry R. Bowen 1991
  6. ; ---------------------------------------------------------|
  7. ; Variables:
  8. ; BN     = Block name of window model
  9. ; FILE   = Data file
  10. ; GRIL   = Grille option type [Global]
  11. ; HUWD   = Half the window unit length
  12. ; HUHT   = Half the window unit height
  13. ; LINE   = One line in the data file
  14. ; S1     = Sash opening width
  15. ; S2     = Sash opening height
  16. ; S3     = Divided grille type
  17. ; S4     = Diamond grille type
  18. ; SIZE   = Unit size
  19. ; UNITWD = Unit width
  20. ; UNITHT = Unit height
  21. ; WINVW  = View option [Global]
  22. ;
  23. ; Sample Call: (NATWIN "2832" 1 "3-2DH.DAT")
  24. ;                where "2832" is the model number
  25. ;                      1 is the number of windows and
  26. ;                      "3-2DH.DAT" is the data file.
  27. ; ---------------------------------------------------------|
  28.  
  29. (defun NATWIN (SIZE QTY DATA / BN BM CL EN EN1 FILE HUWD
  30.                HUHT LINE S1 S2 S3 S4 SIZE UNITWD UNITHT)
  31.   (V3)
  32.   (if (= WINVW nil) (progn
  33.       (initget 1 "PL EL")
  34.       (setq WINVW (getkword "\n<PL>an/<EL>evation: "))))
  35.   (if (/= WINVW "PL")
  36.       (setq MPT (getpoint "\nInsertion Point: ")))
  37.   (setq EN (entlast)
  38.       FILE (open DATA "r")
  39.         SL (strlen SIZE)
  40.       LINE (read-line FILE))
  41.   (while (and LINE (/= SIZE (substr LINE 1 SL)))
  42.     (setq LINE (read-line FILE)))
  43.   (close FILE)
  44.   (if (not (member LINE '(nil "")))
  45.     (if (= SIZE (substr LINE 1 SL))
  46.       (progn
  47.          (WINDAT)
  48.          (setq UNITWD (+ S1 4.0)
  49.                UNITHT (+ S2 4.5)
  50.                  HUWD (/ UNITWD 2.0)
  51.                  HUHT (/ UNITHT 2.0))
  52.          (if (= WINVW "EL") (WINEL) (WINPL))
  53.          (RL)
  54.     ) )
  55.     (prompt "\nRequested Size Not In Data File!")
  56.   ) (princ)
  57.   (V4)
  58. )
  59.  
  60. ; ----------------------- WINDAT --------------------------|
  61. ; Get Data from required file
  62. (defun WINDAT ()
  63.    (setq BN (substr LINE 1 4)
  64.          BN (strcat WTYP "-" BN GRIL "-" WINVW)
  65.          S1 (atof (substr LINE 11 10))
  66.          S2 (atof (substr LINE 21 10))
  67.          S3 (substr LINE 31 7)
  68.          S4 (substr LINE 41 8)))
  69.  
  70. ; ------------------------ WINEL --------------------------|
  71. ; Draw Window in Elevation view
  72. (defun WINEL (/ PT1 PT2 PT2A PT3 PT4 PT5 PT5A PT6 PT7 PT8
  73.                 PT9 LWINH LWINW)
  74.   (if (= (tblsearch "block" BN) nil)
  75.    (progn
  76.     (prompt "\nBuilding Window Block......Please Wait ")
  77.     (LS "A-GLAZ-ELEV" "2" "")
  78.     (setq PT1 (polar MPT pi HUWD)
  79.           PT2 (polar PT1 (D90) 1.25)
  80.           PT3 (polar PT2 0 UNITWD)
  81.          PT2A (polar PT3 pi 0.75)
  82.           PT4 (polar PT2 0 0.75)
  83.           PT5 (polar (polar PT4 0 1.25) (D90) 1.25)
  84.          PT5A (polar PT5 0 S1)
  85.           PT6 (polar (polar PT5 0 1.0) (D90) 2.0)
  86.           PT7 (polar PT5 (D90) (/ S2 2.0))
  87.           PT8 (polar PT7 0 S1)
  88.           PT9 (polar (polar PT7 0 1.0) (D90) 1.0)
  89.         LWINW (- S1 2.0)
  90.         LWINH (- (/ S2 2.0) 2.0)
  91.     )
  92.     (command "insert" "rectang" PT1 UNITWD UNITHT 0
  93.          "insert" "1DN" PT4 (- UNITWD 1.5) (- UNITHT 2.0) 0
  94.          "insert" "rectang" PT5 S1 S2 0
  95.          "insert" "1UP" PT6 LWINW LWINH 0
  96.          "insert" "rectang" PT9 LWINW LWINH 0
  97.          "line" PT2 PT3 ""
  98.          "line" PT4 PT5 ""
  99.          "line" PT2A PT5A ""
  100.          "line" PT7 PT8 "")
  101.     (if (/= GRIL "NG") (LS "A-GLAZ-GRIL" "1" ""))
  102.     (cond
  103.       ((= GRIL "G1") (command "insert" S3 PT6 LWINW LWINH 0
  104.                             "insert" S3 PT9 LWINW LWINH 0))
  105.       ((= GRIL "G2") (command "insert" S4 PT6 LWINW LWINH 0
  106.                             "insert" S4 PT9 LWINW LWINH 0))
  107.     )
  108.     (MKSET)
  109.     (command "block" BN MPT SS1 ""
  110.              "insert" BN MPT 1 1 0)
  111.   ) ;End Progn
  112.   (command "insert" BN MPT 1 1 0)
  113.   ) ;End IF
  114.   (cond
  115.    ((= QTY 2)
  116.     (command "move" (entlast) "" MPT (polar MPT 0 HUWD)
  117.              "copy" (entlast) "" MPT (polar MPT pi UNITWD)))
  118.    ((= QTY 3) (setq EN (entlast))
  119.     (command "copy" EN "" PT2 PT3
  120.              "copy" EN "" PT3 PT2))
  121.   ) ;End Cond
  122. )
  123.  
  124. ; ------------------------ WINPL --------------------------|
  125. ; Install window in Plan View
  126. (defun WINPL (/ ANG ANG1 HLGTH LGTH PT PT1 PT2 PT3 PT4 WPT)
  127.   (prompt "\nSelect Outside Wall Line For Midpoint: ")
  128.   (setq EN (entsel)
  129.         PT (cadr EN)
  130.         MPT (osnap PT "mid")
  131.         EN1 (car EN)
  132.         PT1 (cdr (assoc 10 (entget EN1)))
  133.         PT2 (cdr (assoc 11 (entget EN1)))
  134.         ANG (angle PT1 PT2))
  135.   (command "osnap" "per")
  136.   (setq WPT (getpoint MPT "\nSelect Inside Wall: "))
  137.   (command "osnap" "none")
  138.   (setq HLGTH HUWD LGTH UNITWD)
  139.   (cond
  140.    ((= QTY 2) (setq HLGTH UNITWD LGTH (* 2 UNITWD)))
  141.    ((= QTY 3) (setq HLGTH (* 1.5 UNITWD) LGTH (* 3 UNITWD)))
  142.   )
  143.   (setq ANG1 (angle MPT WPT)
  144.          PT1 (polar MPT (A180) HLGTH)
  145.          PT2 (polar PT1 ANG LGTH)
  146.          PT3 (polar PT1 ANG1 4.0)
  147.          PT4 (polar PT2 ANG1 4.0))
  148.   (if (= (tblsearch "block" BN) nil)
  149.     (progn
  150.       (LS "A-GLAZ" "2" "")
  151.       (command "insert" "WINPL" MPT 1 UNITWD 0
  152.                "block" BN MPT (entlast) "")
  153.   ) )
  154.   (LS "A-WALL" "3" "")
  155.   (command "break" PT1 PT2
  156.            "break" PT3 PT4
  157.            "line" PT1 PT3 ""
  158.            "line" PT2 PT4 "")
  159.   (LS "WNDS" "2" "")
  160.   (cond
  161.    ((= QTY 2)
  162.      (command "insert"
  163.                    BN (polar MPT ANG HUWD) 1 1 (angtos ANG1)
  164.      "insert" BN (polar MPT (A180) HUWD) 1 1 (angtos ANG1)))
  165.    ((= QTY 3) (command "insert" BN MPT 1 1 (angtos ANG1))
  166.      (command "insert"
  167.                  BN (polar MPT ANG UNITWD) 1 1 (angtos ANG1)
  168.    "insert" BN (polar MPT (A180) UNITWD) 1 1 (angtos ANG1)))
  169.    (T (command "insert" BN MPT 1 1 (angtos ANG1)))
  170.   )
  171. )
  172.  
  173. ; ------------------------ V3.LSP -------------------------|
  174. (defun V3 ()
  175.   (setq BM (getvar "blipmode") OS (getvar "osmode"))
  176.   (setvar "blipmode" 0)
  177.   (setvar "cmdecho" 0)
  178.   (command "undo" "group" "osnap" "none"))
  179.  
  180. ; ------------------------ V4.LSP -------------------------|
  181. (defun V4 (/ BA)
  182.   (setvar "blipmode" BM)
  183.   (setvar "osmode" OS)
  184.   (command "undo" "end")
  185.   (prompt "\n")
  186.   (setq BA "Program Completed. . . . ."))
  187.  
  188. ; ------------------------- LS ----------------------------|
  189. ; Layer search command for creating new layers.
  190. (defun LS (NLAY CLR LT / LAY)
  191.  (setq CL (getvar "clayer"))
  192.  (setq LAY (tblsearch "layer" NLAY))
  193.  (if (not LAY)
  194.    (command "layer" "m" NLAY "c" CLR "" "lt" LT "" "");True
  195.     (progn
  196.       (setq FRZ (cdr (assoc 70 LAY)))
  197.       (if (= FRZ 65)
  198.         (progn
  199.          (command "layer" "t" NLAY "")
  200.          (command "layer" "s" NLAY "")
  201.         )
  202.          (command "layer" "s" NLAY "") ;False
  203. ))  ) )
  204.  
  205. ; -------------------------- RL ---------------------------|
  206. ; Resets the previous layer to the current layer.
  207. (defun RL () (command "layer" "s" CL ""))
  208.  
  209. ; ------------------------ MKSET --------------------------|
  210. ; Make a selection-set of all entities
  211. (defun MKSET ()
  212.    (setq SS1 (ssadd) EN1 (entnext EN))
  213.    (while EN
  214.      (setq SS1 (ssadd EN1 SS1)
  215.            EN1 (entnext EN)
  216.            EN EN1)))
  217.  
  218. ; ------------------------ D90 ----------------------------|
  219. (defun D90 () (* pi 0.5))
  220.  
  221. ; ------------------------ A180 ---------------------------|
  222. (defun A180 () (+ ANG pi))
  223.  
  224. ; ---------------------- *ERROR* --------------------------|
  225. (defun *error* (MSG)
  226.   (princ "error: ")
  227.   (princ MSG)
  228.   (foreach SVAR '("menuecho" "blipmode") (setvar SVAR 1))
  229.   (foreach SVAR '("cmdecho" "snapang" "highlight")
  230.                  (setvar SVAR 0))
  231.   (princ))
  232.  
  233. (prompt "\nWindow Program Loaded.............")
  234. (prompt "\nCopyright (c) Barry R. Bowen 1991 ")
  235. (princ)
  236. 
  237.