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