home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / SLT4.LSP < prev    next >
Encoding:
Text File  |  1991-12-01  |  5.5 KB  |  182 lines
  1. (defun spinfo ()
  2.    (setq cp (getpoint "\nCenter of Spiral Staircase:"))
  3.    (setq sp (getpoint "\nLower Left Corner of Staircase:"))
  4.    (setq riser (getreal "\nRiser:"))
  5.    (setq step (getreal "\nStep:"))
  6.    (setq wide (getreal "\nWidth:"))
  7.    (setq case (getint "\nNo. of Steps:"))
  8.    (setq hrl (getreal "\nHelght of Handrail:"))
  9. )
  10. (defun spcalc ()
  11.    (setq blkfil (open "blocks.mem" "r"))
  12.    (if (not (equal blkfil nil))
  13.        (setq blk (read-line blkfil))
  14.    )
  15.    (if (equal blk nil)
  16.        (setq blk "$$1")
  17.        (setq blk 
  18.           (strcat "$$" 
  19.                    (itoa 
  20.                          (1+ 
  21.                              (atoi (substr blk 3))  
  22.                          )
  23.                    )
  24.            )
  25.        )
  26.     )
  27.     (setq pt4 (polar sp 0 wide))
  28.     (setq uppt1 (list (car sp) (cadr sp) riser))
  29.     (setq uppt4 (list (car pt4) (cadr pt4) riser))
  30.     (setq count 0)
  31.     (setq el riser)
  32.     (command "line" sp pt4 "")
  33.     (command "arc" (polar sp 
  34.                           (angle sp pt4)
  35.                           (/ (distance sp pt4) 2.0)
  36.                    )
  37.       "c" cp "L" step
  38.     )
  39.     (command "line" "" 0 "")
  40.     (setq rp (getvar "LASTPOINT"))
  41.     (COMMAND "ERASE" rp "")
  42.     (command "erase" rp
  43.                  (polar sp
  44.                        (angle sp pt4)
  45.                       (/ (distance sp pt4) 3.0)
  46.                  )
  47.        "")
  48.      (setq diag (angle cp rp))
  49.      (setq incr diag)
  50.      (setq uppt3
  51.            (list (car (polar cp diag (distance cp pt4)))
  52.                  (cadr (polar cp diag (distance cp pt4)))
  53.                  riser
  54.            )
  55.      )
  56.      (setq uppt2
  57.            (list (car (polar cp diag (distance cp sp)))
  58.                  (cadr (polar cp diag (distance cp sp)))
  59.                  riser
  60.            )
  61.      )  
  62.      (setq hrlpt3
  63.            (list (car (polar uppt4
  64.                         (angle uppt4 uppt1)
  65.                         (/ (distance uppt4 uppt1) 10)
  66.                       )
  67.                  )
  68.                  (cadr (polar uppt4
  69.                         (angle uppt4 uppt1)
  70.                         (/ (distance uppt4 uppt1) 10)
  71.                       )
  72.                  )
  73.                  (+ riser hrl)
  74.             )
  75.       )
  76.      (setq hrlpt4
  77.            (list (car (polar uppt3
  78.                         (angle uppt3 uppt2)
  79.                         (/ (distance uppt3 uppt2) 10)
  80.                       )
  81.                  )
  82.                  (cadr (polar uppt3
  83.                         (angle uppt3 uppt2)
  84.                         (/ (distance uppt3 uppt2) 10)
  85.                       )
  86.                  )
  87.                  (+ riser riser hrl)
  88.             )
  89.       )
  90.      (setq hrlpt1
  91.            (list (car (polar hrlpt3
  92.                         (angle hrlpt3 hrlpt4)
  93.                         (/ (distance hrlpt3 hrlpt4) 2)
  94.                       )
  95.                  )
  96.                  (cadr (polar hrlpt3
  97.                         (angle hrlpt3 hrlpt4)
  98.                         (/ (distance hrlpt3 hrlpt4) 2)
  99.                       )
  100.                  )
  101.                  (+ riser (/ riser 2) hrl)
  102.             )
  103.       )
  104.      (setq hrlpt2
  105.            (list (car (polar hrlpt3
  106.                         (angle hrlpt3 hrlpt4)
  107.                         (/ (distance hrlpt3 hrlpt4) 2)
  108.                       )
  109.                  )
  110.                  (cadr (polar hrlpt3
  111.                         (angle hrlpt3 hrlpt4)
  112.                         (/ (distance hrlpt3 hrlpt4) 2)
  113.                       )
  114.                  )
  115.                   riser
  116.             )
  117.       )
  118.       (command "3dface" uppt1 uppt2 uppt3 uppt4 "")
  119.       (command "3dface" sp uppt1 uppt4 pt4 "")
  120.       (command "3dline" hrlpt1 hrlpt2 "")
  121.       (command "3dline" hrlpt3 hrlpt4 "")
  122.       (command "block" blk sp "c" (polar sp (dtr 215) 0.1)
  123.                                   (polar pt4 (dtr 90) (distance uppt4 uppt3))
  124.                                ""
  125.       )
  126.       (command "oops")
  127.       (setq count (1+ count))
  128.       (setq diag2 (angle uppt1 uppt2))
  129.       (setq isd (distance uppt1 uppt2))
  130.       (setq sp (list 
  131.                 (car (polar sp diag2 isd))
  132.                 (cadr (polar sp diag2 isd))
  133.                riser
  134.                )
  135.        )
  136.       (setq insang (* (/ diag pi) 180))
  137.       (setq riser (+ riser el))
  138. )
  139. (defun sbuild ()
  140.       (command "insert" blk sp "" "" insang)
  141.       (setq diag2 (+ diag2 incr))
  142.       (setq sp
  143.             (list (car (polar sp diag2 isd))
  144.                   (cadr (polar sp diag2 isd))
  145.             riser
  146.             )
  147.       )
  148.       (setq diag (+ diag incr))
  149.       (setq insang (* (/ diag pi) 180))
  150.       (setq count (1+ count))
  151.       (setq riser (+ riser el))
  152. )
  153. (defun pole ()
  154.       (command "circle" cp
  155.                           (polar cp 0 (/ (distance cp sp) 10))
  156.       )
  157.       (command "change" "l" "" "p" "e" 0 "th" (+ riser 65) "")
  158. )
  159. (defun C:SLT4 ()
  160.        (setq oldblp (getvar "BLIPMODE"))
  161.        (setq oldech (getvar "CMDECHO"))
  162.        (setq oldelv (getvar "ELEVATION"))
  163.        (setvar "BLIPMODE" 0)
  164.        (setvar "CMDECHO" 0)
  165.        (setvar "ELEVATION" 0)
  166.        (spinfo)
  167.        (spcalc)
  168.        (while (< count case) (sbuild))
  169.        (pole)
  170.        (setvar "BLIPMODE" oldblp)
  171.        (setvar "CMDECHO" oldech)
  172.        (setvar "ELEVATION" oldelv)
  173.        (if (not (equal blkfil nil)) (close blkfil))
  174.        (setq blkfil (open "blocks.mem" "w"))
  175.        (write-line blk blkfil)
  176.        (close blkfil)
  177. )
  178. (defun dtr (a)
  179.      (* pi (/ a 180.0))
  180. )
  181.  
  182.