home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / LT.LSP < prev    next >
Encoding:
Text File  |  1992-02-11  |  26.4 KB  |  681 lines
  1. (vmon)
  2. (defun lterr(s)
  3.    (if (/= s "Function cancelled")
  4.        (princ (strcat "\nError:" s))
  5.    )
  6.    (command "layer" "s" "0" "")
  7.    (setvar "cmdecho" 1)
  8.    (setq *error* oer)
  9.    (princ)
  10. )
  11.  
  12. (defun C:LT(/ file se se2 ss ss1 oer terh s1 tw tw0 tl1 tl2 axdl x p ang tw1 tw2 tw3 tes hg th wide1 step1 cp1 sp1 riser1 case1 kword kword2 agi clh cr rp1 w2 hrl1)
  13.    (setvar "cmdecho" 0)
  14.    (setvar "AFLAGS" 0)
  15.    (setq oldatm (getvar "ATTMODE"))
  16.    (SETVAR "ATTMODE" 0)
  17.    (setq oer *error* *error* lterr)
  18.    (setq s1 (getstring "\n╩Σ╚δ┬Ñ╠▌╩╜╤∙4/3/2/<1>:"))
  19.    (if (= s1 "") (setq s1 "1"))
  20.    (if (and (>= s1 "1") (<= s1 "4")) (progn
  21.    (cond ((= s1 "1") (setq tes 1)
  22.                      (while (/= tes 0)
  23.                      (setq tl1 (getstring "\n╩Σ╚δ┬Ñ╠▌╢╬╕≈┐φ╢╚ <1650,1650>:"))
  24.                      (if (= tl1 "") (setq tl1 "1650,1650"))
  25.                      (sub11 tl1) (setq tl1 axdl)
  26.                      (if (> (length tl1) 3) (princ "\n┬Ñ╠▌▓╗─▄╢α╙┌3┼▄ !")
  27.                                             (setq tes 0))
  28.                      );while 
  29.                      (setq tw1 (getint "\n╩Σ╚δ╠ñ▓╜┐φ <270>:"))
  30.                      (if (= tw1 nil) (setq tw1 270))
  31.                      (setq tw2 (getint "\n╩Σ╚δ╠ñ▓╜╩² <11>:"))
  32.                      (if (= tw2 nil) (setq tw2 11))
  33.                      (setq tw2 (1- tw2))
  34.                      (setq hg (getint "\n╩Σ╚δ╠ñ▓╜╕▀ <150>:"))
  35.                      (if (= hg nil) (setq hg 150)) 
  36.                      (setq tl2 (getint "\n╩Σ╚δ╨▌╧ó░σ│ñ╢╚ <1800>:"))
  37.                      (if (= tl2 nil) (setq tl2 1800))
  38.                      (setq th (getint "\n╩Σ╚δ╨▌╧ó░σ║±╢╚ <120>:"))
  39.                      (if (= th nil) (setq th 120))
  40.                      (setq hrl1 (getint "\n╩Σ╚δ┬Ñ╠▌╖÷╩╓╕▀╢╚ <1100>:"))
  41.                      (if (= hrl1 nil) (setq hrl1 1100)))
  42.          ((= s1 "2") (setq tl1 (getint "\n╩Σ╚δ┬Ñ╠▌╢╬┐φ <1650>:"))
  43.                      (if (= tl1 nil) (setq tl1 1650))
  44.                      (setq tw1 (getint "\n┬Ñ╠▌╠ñ▓╜┐φ <270>:"))
  45.                      (if (= tw1 nil) (setq tw1 270))
  46.                      (setq tw2 (getint "\n╩Σ╚δ╫≤╙╥┬Ñ╠▌╠ñ▓╜╩² <8>:"))
  47.                      (if (= tw2 nil) (setq tw2 8))
  48.                      (setq tw2 (1- tw2))
  49.                      (setq tw3 (getint "\n╩Σ╚δ╔╧├µ┬Ñ╠▌╠ñ▓╜╩² <8>:"))
  50.                      (if (= tw3 nil) (setq tw3 8))
  51.                      (setq tw3 (1- tw3))
  52.                      (setq hg (getint "\n╩Σ╚δ╠ñ▓╜╕▀ <150>:"))
  53.                      (if (= hg nil) (setq hg 150)) 
  54.                      (setq tl2 (getint "\n╩Σ╚δ╨▌╧ó░σ│ñ╢╚ <1800>:"))
  55.                      (if (= tl2 nil) (setq tl2 1800))
  56.                      (setq th (getint "\n╩Σ╚δ╨▌╧ó░σ║±╢╚ <120>:"))
  57.                      (if (= th nil) (setq th 120))
  58.                      (setq hrl1 (getint "\n╩Σ╚δ┬Ñ╠▌╖÷╩╓╕▀╢╚ <1100>:"))
  59.                      (if (= hrl1 nil) (setq hrl1 1100)))
  60.          ((= s1 "3") (setq tl1 (getint "\n╩Σ╚δ╧┬├µ┬Ñ╠▌╢╬┐φ╢╚ <1650>:"))
  61.                      (if (= tl1 nil) (setq tl1 1650))
  62.                      (setq tw2 (getint "\n╩Σ╚δ╧┬├µ┬Ñ╠▌╠ñ▓╜╩² <11>:"))
  63.                      (if (= tw2 nil) (setq tw2 11))
  64.                      (setq tw2 (1- tw2))
  65.                      (setq tl2 (getint "\n╩Σ╚δ╔╧├µ┬Ñ╠▌╢╬┐φ╢╚ <1650>:"))
  66.                      (if (= tl2 nil) (setq tl2 1650))
  67.                      (setq tw3 (getint "\n╩Σ╚δ╔╧├µ┬Ñ╠▌╠ñ▓╜╩² <8>:"))
  68.                      (if (= tw3 nil) (setq tw3 8))
  69.                      (setq tw3 (1- tw3))
  70.                      (setq tw1 (getint "\n╩Σ╚δ╠ñ▓╜┐φ <270>:"))
  71.                      (if (= tw1 nil) (setq tw1 270))
  72.                      (setq hg (getint "\n╩Σ╚δ╠ñ▓╜╕▀ <150>:"))
  73.                      (if (= hg nil) (setq hg 150)) 
  74.                      (setq th (getint "\n╩Σ╚δ╨▌╧ó░σ║±╢╚ <120>:"))
  75.                      (if (= th nil) (setq th 120))
  76.                      (setq hrl1 (getint "\n╩Σ╚δ┬Ñ╠▌╖÷╩╓╕▀╢╚ <1100>:"))
  77.                      (if (= hrl1 nil) (setq hrl1 1100)))
  78.             ((= s1 "4")
  79.                      (setq sp1 (getint "\n╩Σ╚δ╘░┬Ñ╠▌─┌░δ╛╢ <750>:"))
  80.                      (if (= sp1 nil) (setq sp1 750))
  81.                      (setq riser1 (getint "\n╩Σ╚δ╘░┬Ñ╠▌╠ñ▓╜╕▀ <150>:"))
  82.                      (if (= riser1 nil) (setq riser1 150))
  83.                      (setq step1 (getint "\n╩Σ╚δ╘░┬Ñ╠▌╠ñ▓╜┐φ <270>:"))
  84.                      (if (= step1 nil) (setq step1 270))
  85.                      (setq wide1 (getint "\n╩Σ╚δ╘░┬Ñ╠▌┐φ <1600>:"))
  86.                      (if (= wide1 nil) (setq wide1 1600))
  87.                      (setq case1 (getint "\n╩Σ╚δ╘░┬Ñ╠▌╠ñ▓╜╩² <24>:"))
  88.                      (if (= case1 nil) (setq case1 24))
  89.                      (setq th (getint "\n╩Σ╚δ┬Ñ╠▌╢╬║±╢╚ <150> :"))
  90.                      (if (= th nil) (setq th 150)) 
  91.                      (setq hrl1 (getint "\n╩Σ╚δ╘░┬Ñ╠▌╖÷╩╓╕▀ <1100>:"))
  92.                      (if (= hrl1 nil) (setq hrl1 1100))
  93.                      (setq w2 (+ wide1 sp1))
  94.                      (setq kword "No" kword2 "Yes")
  95.                      (initget "Yes No")
  96.                      (setq kword (getkword "\n╙╨╘░┬Ñ╠▌╓∙╖±? Yes/No <N>:"))
  97.                      (if (= kword "Yes") (progn
  98.                             (setq clh (getint "\n╩Σ╚δ╓∙╕▀ <3600> :"))
  99.                             (if (= clh nil) (setq clh 3600))
  100.                             (setq cr (getint "\n╩Σ╚δ╘░┬Ñ╠▌╓∙░δ╛╢ <300>:"))
  101.                             (if (= cr nil) (setq cr 300))
  102.                             (setq rp1 (- sp1 cr))
  103.                             (initget "Yes No")
  104.                    (setq kword2 (getkword "\n╙╨╘░┬Ñ╠▌─┌▓α╖÷╩╓╖±? Yes/No <Y>:"))
  105.                    (if (= kword2 nil) (setq kword2 "Yes"))
  106.                                          )
  107.                      )  
  108.          )    
  109.     )
  110.    (graphscr)
  111.    (initget 1 "R")
  112.    (setq p (getpoint "\n▓╬┐╝╡πR/<▓σ╚δ╡π>:"))
  113.    (if (= p "R") (progn (setq p (getpoint "\n▓╬┐╝╡π:"))
  114.                  (setq p (getpoint p "\n▓σ╚δ╡π:"))))
  115.    (setq ang (getangle p "\n▓σ╚δ╖╜╧≥ <0>:"))
  116.    (if (= ang nil) (setq ang 0))
  117.    (if (= s1 "4") (setq cp1 p sp1 (polar cp1 0 sp1) agi (rtd ang))
  118.                   (setq agi 0))
  119.    (command "layer" "m" "pstair" "")
  120.    (setq se nil se2 nil ss (ssadd))
  121.    (cond ((= s1 "1") (lt1 tl1 tl2 tw1 tw2 p ang hg th hrl1))
  122.          ((= s1 "2") (lt2 tl1 tw1 tw2 tw3 p ang hg th hrl1))
  123.          ((= s1 "3") (lt3 tl1 tl2 tw1 tw2 tw3 p ang hg th hrl1))
  124.          ((= s1 "4") (lt4 cp1 sp1 riser1 step1 wide1 case1 hrl1 ang))
  125.    )
  126.    (if (/= s1 "4") (progn
  127.      (load "lisp/ltd") (C:ltd)
  128.      (load "lisp/lt0") (C:lt0)
  129.    ))
  130.      (command "layer" "m" "pstair" "")
  131.      (COMMAND "BLOCK" FILE P SS "")
  132.      (command "insert" file p "" "" agi "")
  133.      (COMMAND "LAYER" "F" "PSTAIRAT" "")
  134.       (command "layer" "s" "0" "")
  135.   ))
  136.    (SETVAR "ATTMODE" OLDATM)
  137.    (setvar "cmdecho" 1)
  138.    (setq *error* oer)
  139.    (princ)
  140. )
  141.  
  142. (defun lt1(tl11 tl22 tw11 tw22 p1 ang1 hg1 th1 hrl / at at1 at2 lnt nt ff ef plw l1 l ang0 ang2 n p2 p3 p4 p5 p6 p7 p8 p9)
  143.    (setq plw (getvar "userr1"))
  144.    (setq lnt (length tl11))
  145.     (setq nt (1- lnt) at2 (itoa (nth nt tl11)))
  146.   (repeat (1- lnt)
  147.    (setq at1 (itoa (nth (1- nt) tl11)) at2 (strcat at1 "," at2) nt (1- nt))
  148.   )
  149. (setq at (strcat at2 " " (itoa tl22) " " (itoa tw11) " " (itoa (1+ tw22)) " " (rtos ang1 2 5) " " (itoa hg1) " " (itoa th1) " " (itoa hrl)))
  150.    (setq file "ST1-1" ff "ST1-" ef 1)
  151.    (while (/= (tblsearch "BLOCK" file) nil)
  152.      (setq ef (1+ ef) file (strcat ff (itoa ef)))
  153.    ) 
  154.    (setq at (strcat "T1" " " at))
  155.     (if (/= (tblsearch "LAYER" "PSTAIRAT") nil)
  156.        (command "layer" "T" "PSTAIRAT" "")
  157.     )
  158.     (COMMAND "LAYER" "M" "PSTAIRAT" "")
  159.    (command "attdef" "" "LT" "" at "C" p1 "" "")
  160.    (setq se (entlast)) (ssadd se ss) 
  161.    (COMMAND "LAYER" "M" "PSTAIR" "")
  162.    (setq l1 (+ (* tw11 tw22) tl22))
  163.    (setq l (length tl11) ang0 (- ang1 1.57079) ang2 (+ ang1 1.57079))
  164.    (if (= l 1) (progn
  165.    (setq tl1 (- (nth 0 tl11) plw))
  166.    (setq p2 (polar p1 ang0 l1) p3 (polar p2 ang1 (+ tl1 plw)))
  167.    (setq p4 (polar p3 ang2 (- (* tw11 (1+ tw22)) plw)) p5 (polar p4 ang1 (- tw11 plw)))
  168.    (setq p6 (polar p5 ang2 plw) p7 (polar p6 (+ ang1 pi) tw11))
  169.    (setq p8 (polar p7 ang0 (+ (* 0.5 tw11) (* tw11 tw22))) p9 (polar p8 ang1 plw))
  170.    (command "line" p2 p3 p4 p5 p6 p7 p8 p9 "")
  171.    (setq se (entlast)) (ssadd se ss)
  172.    (repeat tw22
  173.    (setq p2 (polar p2 ang2 tw11) p3 (polar p2 ang1 tl1))
  174.    (command "line" p2 p3 "")
  175.       (setq se (entlast)) (ssadd se ss)
  176.    ))
  177.    (progn
  178.    (setq n 0)
  179.    (repeat l
  180.       (if (> n 0) (progn
  181.       (setq p4 (polar p33 ang0 (* 0.5 tw11)) p5 (polar p4 ang1 (* 3 plw)))
  182.       (setq p6 (polar p5 ang2 (* (1+ tw22) tw11)) p7 (polar p6 (+ ang1 pi) (* 3 plw)))
  183.       (command "pline" p4 "w" 0 "" p5 p6 p7 "c")
  184.       (setq se (entlast)) (ssadd se ss)
  185.       (command "offset" plw (list (entlast) p4) (polar (polar p4 ang1 (* 1.5 plw)) ang2 50) "")
  186.       (setq se (entlast)) (ssadd se ss)
  187.       (setq p2 (polar p1 ang0 l1) p2 (polar p2 ang1 (* 1.5 plw)))
  188.       )
  189.       (setq p2 (polar p1 ang0 l1))
  190.       ) ;endif
  191.       (if (or (= n 0) (= n (1- l))) (setq w1 (- (nth n tl11) (* 1.5 plw))) (setq w1 (- (nth n tl11) (* 3 plw))))
  192.       (setq p3 (polar p2 ang1 w1) p33 p3)
  193.       (repeat (1+ tw22)
  194.          (command "line" p2 p3 "")
  195.          (setq se (entlast)) (ssadd se ss)
  196.          (setq p2 (polar p2 ang2 tw11) p3 (polar p2 ang1 w1))
  197.       )
  198.       (setq p1 (polar p1 ang1 (nth n tl11)))
  199.       (setq n (1+ n))
  200.    )
  201.    )) ;endif
  202. )
  203.  
  204. (defun lt2(tl11 tw11 tw22 tw33 p1 ang1 hg1 th1 hrl / at ff ef plw l2 l1 p2 p3 p4 p5 ang0 ang2)
  205. (setq at (strcat (itoa tl11) " " (itoa tw11) " " (itoa (1+ tw22)) " " (itoa (1+ tw33)) " " (rtos ang1 2 5) " " (itoa hg1) " " (itoa th1) " " (itoa hrl)))
  206.    (setq file "ST2-1" ff "ST2-" ef 1)
  207.    (while (/= (tblsearch "BLOCK" file) nil)
  208.      (setq ef (1+ ef) file (strcat ff (itoa ef)))
  209.    ) 
  210.    (setq at (strcat "T2" " " at))
  211.     (if (/= (tblsearch "LAYER" "PSTAIRAT") nil)
  212.        (command "layer" "T" "PSTAIRAT" "")
  213.     )
  214.     (COMMAND "LAYER" "M" "PSTAIRAT" "")
  215.    (command "attdef" "" "LT" "" at "C" p1 "" "")
  216.    (setq se (entlast)) (ssadd se ss) 
  217.    (setq plw (getvar "userr1") ang0 (- ang1 1.57079) ang2 (+ ang1 1.57079) l1 (+ tl11 (* tw11 tw22) (* 0.5 tw11)))
  218.    (setq l2 (+ (* (1+ tw33) tw11) tl11) l3 (+ tl11 (* 0.5 tw11)))
  219.    (setq p2 (polar p1 ang0 l1) p3 (polar p2 ang1 tl11))
  220.    (setq p4 (polar p2 ang1 l2) p5 (polar p4 ang1 tl11))
  221.    (COMMAND "LAYER" "M" "PSTAIR" "")
  222.    (repeat (1+ tw22)
  223.       (command "line" p2 p3 "")
  224.    (setq se (entlast)) (ssadd se ss)
  225.       (command "line" p4 p5 "")
  226.    (setq se (entlast)) (ssadd se ss)
  227.       (setq p2 (polar p2 ang2 tw11) p3 (polar p2 ang1 tl11))
  228.       (setq p4 (polar p4 ang2 tw11) p5 (polar p4 ang1 tl11))
  229.    )
  230.       (setq p2 (polar p1 ang1 l3) p3 (polar p2 ang0 tl11))
  231.       (repeat (1+ tw33)
  232.          (command "line" p2 p3 "")
  233.    (setq se (entlast)) (ssadd se ss)
  234.          (setq p2 (polar p2 ang1 tw11) p3 (polar p2 ang0 tl11))
  235.       )
  236.       (setq l2 (* (1+ tw22) tw11) l3 (* (1+ tw33) tw11))
  237.       (setq p2 (polar p3 (+ ang1 pi) (* 0.5 tw11)) p3 (polar p2 ang0 l2) p4 (polar p3 (+ ang1 pi) l3) p5 (polar p4 ang2 l2))
  238.       (command "pline" p2 "w" 0 "" p3 p4 p5 "c")
  239.    (setq se (entlast)) (ssadd se ss)
  240.       (command "offset" plw (list (entlast) p2) (polar (polar p4 ang2 tw11) ang1 50) "")
  241.    (setq se (entlast)) (ssadd se ss)
  242. )
  243.  
  244. (defun lt3(tl11 tl22 tw11 tw22 tw33 p1 ang1 hg1 th1 hrl / at ff ef plw ang0 ang2 p2 p3 p4 p5 p6 p7 p8 p9 pkword l1 l2 osn ssn)
  245. (setq at (strcat (itoa tl11) " " (itoa tl22) " " (itoa tw11) " " (itoa (1+ tw22)) " " (itoa (1+ tw33)) " " (rtos ang1 2 5) " " (itoa hg1) " " (itoa th1) " " (itoa hrl)))
  246.    (setq file "ST3-1" ff "ST3-" ef 1)
  247.    (while (/= (tblsearch "BLOCK" file) nil)
  248.      (setq ef (1+ ef) file (strcat ff (itoa ef)))
  249.    ) 
  250.    (setq plw (getvar "userr1") l2 (- (+ tl22 (* 0.5 tw11) (* tw11 tw22)) plw))
  251.    (setq osn (entlast) ang0 (- ang1 1.57079) ang2 (+ ang1 1.57079))
  252.    (setq p2 (polar p1 ang0 l2) p3 (polar p2 ang1 tl11) p33 p3)
  253.    (command "line" p2 p3 "")
  254.    (setq se (entlast)) (ssadd se ss)
  255.    (setq p2 (polar p2 ang2 tw11) p3 (polar p2 ang1 (- tl11 plw)))
  256.    (repeat tw22
  257.       (command "line" p2 p3 "")
  258.    (setq se (entlast)) (ssadd se ss)
  259.       (setq p2 (polar p2 ang2 tw11) p3 (polar p2 ang1 (- tl11 plw)))
  260.    )
  261.    (setq p2 (polar p1 ang1 (+ (- tl11 plw) (* 0.5 tw11))) p3 (polar p2 ang0 (- tl22 plw)))
  262.    (repeat (1+ tw33)
  263.       (command "line" p2 p3 "")
  264.    (setq se (entlast)) (ssadd se ss)
  265.       (setq p2 (polar p2 ang1 tw11) p3 (polar p2 ang0 (- tl22 plw)))
  266.    )
  267.    (setq p2 (polar p33 ang2 (* 0.5 tw11)) p3 (polar p2 ang2 (- (* tw11 tw22) plw)) p4 (polar p3 ang1 (- (* (1+ tw33) tw11) (* 2 plw))) p5 (polar p4 ang0 (- tw11 plw)))
  268.    (setq p6 (polar p5 ang1 plw) p7 (polar p6 ang2 tw11) p8 (polar p7 (+ ang1 pi) (* (1+ tw33) tw11)))
  269.    (setq p9 (polar p8 ang0 (* tw22 tw11)))
  270.    (command "pline" p33 "w" 0 "" p3 p4 p5 p6 p7 p8 p9 p2 "")
  271.    (setq se (entlast)) (ssadd se ss)
  272.    (initget "Yes No")
  273.    (setq pkword (getkword "\n╢╘│╞┐╜▒┤? Yes/No <N>:"))
  274.    (if (= pkword nil) (setq pkword "No"))
  275.    (if (/= pkword "No") (progn
  276.        (setvar "MIRRTEXT" 0)
  277.        (setq ssn nil ssn (ssadd))
  278.      (while (/= (setq osn (entnext osn)) nil) (ssadd osn ssn))
  279.        (command "mirror" ssn "" p1 (polar p1 ang0 50) "N")
  280.        (setvar "MIRRTEXT" 1)
  281.      (while (/= (setq se (entnext se)) nil) (ssadd se ss))
  282.    ))
  283.    (setq at (strcat "T3" " " pkword " " at))
  284.     (if (/= (tblsearch "LAYER" "PSTAIRAT") nil)
  285.        (command "layer" "T" "PSTAIRAT" "")
  286.     )
  287.     (COMMAND "LAYER" "M" "PSTAIRAT" "")
  288.    (command "attdef" "" "LT" "" at "C" p1 "" "")
  289.    (setq se (entlast)) (ssadd se ss) 
  290. )
  291.  
  292. (defun lt4(cp sp riser step wide case hrl ang1 / at ef ff pt4 uppt1 uppt2 uppt3 uppt4 count el riser rp insr diag diag2 hrlpt1 hrlpt2 hrlpt3 hrlpt4 isd fi hrlp21 hrlp31 hrlp41 hrl22 sp2 pt42 uppt32 uppt22 uppt31 w1)
  293.        (setq oldblp (getvar "BLIPMODE"))
  294.        (setq oldelv (getvar "ELEVATION"))
  295.        (setvar "BLIPMODE" 0)
  296.        (setvar "ELEVATION" 0)
  297.        (spcalc)
  298.        (while (< count case) (sbuild))
  299.        (if (= kword "Yes") (pole))
  300.     (setq se2 (entnext se))
  301.     (while (/= se2 nil)
  302.        (ssadd se2 ss)
  303.        (setq se2 (entnext se2))
  304.     )
  305.    (setq at (strcat "T4" " " (rtos ang1 2 5) " " (itoa w2)))
  306.     (if (/= (tblsearch "LAYER" "PSTAIRAT") nil)
  307.        (command "layer" "T" "PSTAIRAT" "")
  308.     )
  309.    (command "layer" "m" "pstairat" "")
  310.    (command "attdef" "" "LT" "" at "C" cp "" "")
  311.    (setq se (entlast)) (ssadd se ss) 
  312.        (setvar "BLIPMODE" oldblp)
  313.        (setvar "ELEVATION" oldelv)
  314. )
  315. (defun spcalc (/ e1 e2 e3 e4 e11 e21 E31 E41 h1 h2 h11 h21 h3 h4 h31 h41)
  316.    (setq file "ST4-1" ff "ST4-" ef 1)
  317.    (while (/= (tblsearch "BLOCK" file) nil)
  318.      (setq ef (1+ ef) file (strcat ff (itoa ef)))
  319.    ) 
  320.     (setq pt4 (polar sp 0 wide))
  321.     (setq uppt1 (list (car sp) (cadr sp) riser))
  322.     (setq uppt4 (list (car pt4) (cadr pt4) riser))
  323.     (setq count 0)
  324.     (setq el riser)
  325.     (command "layer" "m" "pstair" "")
  326.     (command "line" sp pt4 "")
  327.     (setq se (entlast)) (ssadd se ss)
  328.     (command "arc" (polar sp 
  329.                           (angle sp pt4)
  330.                    0)
  331.       "c" cp "L" step
  332.     )
  333.     (command "line" "" 0 "")
  334.     (setq rp (getvar "LASTPOINT"))
  335.     (COMMAND "ERASE" rp "")
  336.     (command "erase" rp
  337.                  (polar sp
  338.                        (angle sp pt4)
  339.                       (/ (distance sp pt4) 3.0)
  340.                  )
  341.        "")
  342.      (setq diag (angle cp rp))
  343.      (setq incr diag)
  344.      (setq uppt3
  345.            (list (car (polar cp diag (distance cp pt4)))
  346.                  (cadr (polar cp diag (distance cp pt4)))
  347.                  riser
  348.            )
  349.      )
  350.      (setq uppt2
  351.            (list (car (polar cp diag (distance cp sp)))
  352.                  (cadr (polar cp diag (distance cp sp)))
  353.                  riser
  354.            )
  355.      )
  356.      (setq uppt22 (list (car uppt2) (cadr uppt2) (- riser th)))
  357.      (setq sp2 (list (car sp) (cadr sp) (- (caddr sp) th)))
  358.      (setq uppt32 (list (car uppt3) (cadr uppt3) (- riser th)))
  359.      (setq pt42 (list (car pt4) (cadr pt4) (- (caddr pt4) th)))
  360.      (command "layer" "m" "pstairb" "")
  361.      (command "3dface" 
  362.                        "i" uppt1 sp2 
  363.                      "i" uppt22 
  364.                      "i" uppt2 "")
  365.      (command "3dface" 
  366.                       "i" uppt4 pt42 
  367.                        "i" uppt32 
  368.                       "i" uppt3 "")
  369.      (command "3dface" 
  370.                        "i" pt42 "i" sp2 
  371.                        "i" uppt22 "i" uppt32  "")
  372.      (setq hrlpt3
  373.            (list (car (polar uppt4
  374.                         (angle uppt4 uppt1)
  375.                         (/ (distance uppt4 uppt1) 10)
  376.                       )
  377.                  )
  378.                  (cadr (polar uppt4
  379.                         (angle uppt4 uppt1)
  380.                         (/ (distance uppt4 uppt1) 10)
  381.                       )
  382.                  )
  383.                  (+ riser hrl)
  384.             )
  385.       )
  386.      (setq hrlpt4
  387.            (list (car (polar uppt3
  388.                         (angle uppt3 uppt2)
  389.                         (/ (distance uppt3 uppt2) 10)
  390.                       )
  391.                  )
  392.                  (cadr (polar uppt3
  393.                         (angle uppt3 uppt2)
  394.                         (/ (distance uppt3 uppt2) 10)
  395.                       )
  396.                  )
  397.                  (+ riser riser hrl)
  398.             )
  399.       )
  400.      (setq w1 (/ (distance hrlpt3 hrlpt4) 3))
  401.      (setq hrlpt1
  402.            (list (car (polar hrlpt3
  403.                         (angle hrlpt3 hrlpt4)
  404.                         w1
  405.                       )
  406.                  )
  407.                  (cadr (polar hrlpt3
  408.                         (angle hrlpt3 hrlpt4)
  409.                         w1
  410.                       )
  411.                  )
  412.                  (- (+ riser (/ riser 2) hrl) 25)
  413.             )
  414.       )
  415.      (setq hrlpt2
  416.            (list (car (polar hrlpt3
  417.                         (angle hrlpt3 hrlpt4)
  418.                        w1
  419.                       )
  420.                  )
  421.                  (cadr (polar hrlpt3
  422.                         (angle hrlpt3 hrlpt4)
  423.                         w1
  424.                        )
  425.                  )
  426.                   riser
  427.             )
  428.       )
  429.      (setq hrl11 (list (car (polar hrlpt3 (angle hrlpt3 hrlpt4) (+ w1 w1)))
  430.                        (cadr (polar hrlpt3 (angle hrlpt3 hrlpt4) (+ w1 w1)))
  431.                        (+ riser (/ riser 2) hrl 25) 
  432.                  )
  433.      ) 
  434.      (setq hrl22 (list (car (polar hrlpt3 (angle hrlpt3 hrlpt4) (+ w1 w1)))
  435.                        (cadr (polar hrlpt3 (angle hrlpt3 hrlpt4) (+ w1 w1)))
  436.                        riser 
  437.                  )
  438.      ) 
  439.       (setq h1 (list (+ (car hrlpt1) 9) (cadr hrlpt1) (caddr hrlpt1)))
  440.       (setq h2 (list (+ (car hrlpt2) 9) (cadr hrlpt2) (caddr hrlpt2)))
  441.       (setq h21 (list (+ (car hrl11) 9) (cadr hrl11) (caddr hrl11)))
  442.       (setq h22 (list (+ (car hrl22) 9) (cadr hrl22) (caddr hrl22)))
  443.       (setq h3 (list (+ (car hrlpt3) 25) (cadr hrlpt3) (caddr hrlpt3)))
  444.       (setq h4 (list (+ (car hrlpt4) 25) (cadr hrlpt4) (caddr hrlpt4)))
  445.       (command "layer" "s" "pstair" "")
  446.       (command "3dface" uppt1 uppt2 uppt3 uppt4 "")
  447.       (command "3dface" sp uppt1 uppt4 pt4 "")
  448.       (command "layer" "m" "pstairh" "")
  449.       (command "circle" hrl11 9)
  450.       (setq e21 (entlast))
  451.       (command "circle" hrl22 9)
  452.       (setq e22 (entlast))
  453.       (command "rulesurf" (list e21 h21) (list e22 h22)) 
  454.       (entdel e21) (entdel e22)
  455.       (command "circle" hrlpt1 9)
  456.       (setq e1 (entlast))
  457.       (command "circle" hrlpt2 9)
  458.       (setq e2 (entlast))
  459.       (command "rulesurf" (list e1 h1) (list e2 h2))
  460.       (entdel e1) (entdel e2)
  461.       (command "circle" hrlpt3 25)
  462.       (setq e3 (entlast))
  463.       (command "circle" hrlpt4 25)
  464.       (setq e4 (entlast))
  465.       (command "rulesurf" (list e3 h3) (list e4 h4)) 
  466.       (entdel e3) (entdel e4)
  467.     (if (= kword2 "Yes") (progn
  468.       (setq hrlp31 
  469.            (list (car (polar uppt1 
  470.                                    (angle uppt1 uppt4)
  471.                                    (/ (distance uppt4 uppt1) 10)
  472.                       )
  473.                  )
  474.                  (cadr (polar uppt1
  475.                        (angle uppt1 uppt4)
  476.                         (/ (distance uppt4 uppt1) 10)
  477.                       )
  478.                  )
  479.                  (+ riser hrl)
  480.             )
  481.       )
  482.       (setq hrlp41
  483.            (list (car (polar uppt2
  484.                         (angle uppt2 uppt3)
  485.                         (/ (distance uppt2 uppt3) 10)
  486.                       )
  487.                  )
  488.                  (cadr (polar uppt2
  489.                         (angle uppt2 uppt3)
  490.                         (/ (distance uppt2 uppt3) 10)
  491.                       )
  492.                  )
  493.                  (+ riser riser hrl)
  494.             )
  495.       )
  496.       (setq hrlp11
  497.            (list (car (polar hrlp31
  498.                         (angle hrlp31 hrlp41)
  499.                         (/ (distance hrlp31 hrlp41) 2)
  500.                       )
  501.                  )
  502.                  (cadr (polar hrlp31
  503.                         (angle hrlp31 hrlp41)
  504.                         (/ (distance hrlp31 hrlp41) 2)
  505.                       )
  506.                  )
  507.                  (+ riser (/ riser 2) hrl)
  508.             )
  509.       )
  510.       (setq hrlp21
  511.            (list (car (polar hrlp31
  512.                         (angle hrlp31 hrlp41)
  513.                         (/ (distance hrlp31 hrlp41) 2)
  514.                       )
  515.                  )
  516.                  (cadr (polar hrlp31
  517.                         (angle hrlp31 hrlp41)
  518.                         (/ (distance hrlp31 hrlp41) 2)
  519.                       )
  520.                  )
  521.                   riser
  522.             )
  523.       )
  524.       (setq h11 (list (+ (car hrlp11) 9) (cadr hrlp11) (caddr hrlp11)))
  525.       (setq h21 (list (+ (car hrlp21) 9) (cadr hrlp21) (caddr hrlp21)))
  526.       (setq h31 (list (car hrlp31) (- (cadr hrlp31) 25) (caddr hrlp31)))
  527.       (setq h41 (list (car hrlp41) (+ (cadr hrlp41) 25) (caddr hrlp41)))
  528.       (command "layer" "s" "pstairh" "")
  529.       (command "circle" hrlp21 9)
  530.       (setq e21 (entlast))
  531.       (COMMAND "circle" hrlp11 9)
  532.       (setq e11 (entlast))
  533.       (command "rulesurf" (list e11 h11) (list e21 h21))
  534.       (entdel e11) (entdel e21) 
  535.       (command "circle" hrlp31 25)
  536.       (setq e31 (entlast))
  537.       (command "circle" hrlp41 25)
  538.       (setq e41 (entlast))
  539.       (command "rulesurf" (list e31 h31) (list e41 h41))
  540.       (entdel e31) (entdel e41) 
  541.                   )
  542.   )
  543.     (setq se2 (entnext se))
  544.     (while (/= se2 nil)
  545.        (ssadd se2 ss)
  546.        (setq se2 (entnext se2))
  547.     )
  548.  
  549.    (setq fi "$$1" ff "$$" ef 1)
  550.    (while (/= (tblsearch "BLOCK" fi) nil)
  551.      (setq ef (1+ ef) fi (strcat ff (itoa ef)))
  552.    )
  553.     (command "layer" "s" "pstair" "") 
  554.       (command "block" FI sp ss "")
  555.    (setq se (entlast))
  556.       (command "oops")
  557.    (setq se (entlast))
  558.       (setq count (1+ count))
  559.       (setq diag2 (angle uppt1 uppt2))
  560. ;      (setq diag3 (angle uppt2 uppt1))
  561.       (setq isd (distance uppt1 uppt2))
  562.       (setq sp (list 
  563.                 (car (polar sp diag2 isd))
  564.                 (cadr (polar sp diag2 isd))
  565.                riser
  566.                )
  567.        )
  568.       (setq insang (rtd diag) in2 0)
  569.       (setq riser (+ riser el))
  570. )
  571. (defun sbuild (/ p11 p21 p31 p41 p12 p22 p32 p42 cp2 lw)
  572.       (command "insert" fi sp "" "" insang)
  573.       (if (and (= kword "Yes") (>= (- insang in2) 90))
  574.           (progn
  575.           (setq cp2 (list (car cp) (cadr cp) (- (caddr sp) el)))
  576.           (setq p11 (polar cp2 diag cr))
  577. ;          (if (< step 350) (setq lw (- step 1))
  578.            (setq lw 350)
  579. ;          )
  580.           (setq p21 (polar p11 diag2 lw))
  581.           (setq p31 (list (car p21) (- (cadr p21) 300) (caddr p21)))
  582.           (setq p41 (list (car p11) (- (cadr p11) 300) (caddr p11)))
  583.           (setq p12 (polar p11 diag (+ rp1 wide)))
  584.           (setq p22 (polar p21 diag (+ rp1 wide)))
  585.           (setq p32 (polar p31 diag (+ rp1 wide)))
  586.           (setq p42 (polar p41 diag (+ rp1 wide)))
  587.           (setq in2 insang)
  588.           (command "layer" "m" "pstairlh" "")
  589.           (command "3dface" p11 p21 p31 p41 "")
  590.           (command "3dface" p12 p22 p32 p42 "")
  591.           (command "3dface" p11 p12 p42 p41 "")
  592.           (command "3dface" p21 p22 p32 p31 "")
  593.           (command "3dface" p41 p31 p32 p42 "")
  594.           (command "3dface" p11 p12 p22 p21 "")
  595.            )
  596.       )
  597.       (setq diag2 (+ diag2 incr))
  598. ;      (setq diag3 (+ diag3 incr))
  599.       (setq sp
  600.             (list (car (polar sp diag2 isd))
  601.                   (cadr (polar sp diag2 isd))
  602.             riser
  603.             )
  604.       )
  605.       (setq diag (+ diag incr))
  606.       (setq insang (rtd diag))
  607.       (setq count (1+ count))
  608.       (setq riser (+ riser el))
  609. )
  610.  
  611. (defun pole (/ h3 h4 e3 e4 cp2)
  612.     (setq cp2 (list (car cp) (cadr cp) (+ (caddr cp) clh)))
  613.     (setq h3 (list (+ (car cp) cr) (cadr cp) (caddr cp)))
  614.     (setq h4 (list (+ (car cp2) cr) (cadr cp2) (caddr cp2)))
  615.     (COMMAND "LAYER" "M" "PSTAIRC" "")
  616.       (command "circle" cp cr)
  617.       (setq e3 (entlast))
  618.       (command "circle" cp2 cr)
  619.       (setq e4 (entlast))
  620.       (command "rulesurf" (list e3 h3) (list e4 h4)) 
  621.       (entdel e3) (entdel e4)
  622. )
  623.  
  624. (defun dtr (a)
  625.      (* pi (/ a 180.0))
  626. )
  627. (defun rtd (a)
  628.      (* (/ a pi) 180)
  629. )
  630.  
  631. (defun instr(st s0 s00 / l n loop x n0 l0)
  632.    (setq l (+ (- (strlen s0) st) 1) l0 0 n0 st n 1 loop t)
  633.    (while (and (<= n l) loop)
  634.       (setq x (substr s0 n0 1))
  635.       (if (eq x s00) (setq loop nil l0 n0) (setq n0 (1+ n0) n (1+ n)))
  636.    )
  637.    (eval l0)
  638. )
  639.  
  640. (defun sub22(af / l0 sp ep)
  641.    (setq l0 (instr 1 af "*") nl nil)
  642.    (setq sp (substr af 1 (- l0 1)) ep (substr af (+ l0 1)))
  643.    (repeat (atoi sp)
  644.       (setq nl (cons (atoi ep) nl))
  645.    )
  646. )
  647.  
  648. (defun sub11(axd / l0 l1 ax nl)
  649.    (setq axdl nil)
  650.    (if (and (= (instr 1 axd ",") 0) (> (strlen axd) 0))
  651.    (progn
  652.    (if (> (instr 1 axd "*") 0)
  653.        (progn
  654.        (sub22 axd)
  655.        (setq axdl nl))
  656.        (setq axdl (cons (atoi axd) axdl))
  657.    )
  658.    )
  659.    (progn
  660.    (setq l0 0 l1 (instr 1 axd ","))
  661.    (while (> (instr (+ l0 1) axd ",") 0)
  662.      (setq ax (substr axd (+ l0 1) (- l1 l0 1)))
  663.      (if (> (instr 1 ax "*") 0) (progn
  664.      (sub22 ax)
  665.      (setq axdl (append nl axdl))
  666.      )
  667.      (setq axdl (cons (atoi ax) axdl))
  668.      )
  669.      (setq l0 l1 l1 (instr (+ l0 1) axd ","))
  670.    )
  671.    (setq ax (substr axd (+ l0 1)))
  672.    (if (> (instr 1 ax "*") 0) (progn
  673.    (sub22 ax)
  674.    (setq axdl (append nl axdl))
  675.    )
  676.    (setq axdl (cons (atoi ax) axdl))
  677.    )
  678.    ))
  679.    (setq axdl (reverse axdl))
  680. )
  681.