home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / LT2.LSP < prev    next >
Encoding:
Text File  |  1992-02-11  |  4.8 KB  |  107 lines
  1. (defun lt2 (/ a x sp ang ang0 ang2 n n0 oer sjd lw lh lbh tz tb0 tb1 tb2 tb00 tb02 tb12 tb22 pl l1 l2 l3 l4 l5 l6 l7 l11 l12 l13 l14 l15 l16 l17 l18 l0 l00 se2 sxb1 sxb2 sxb11 sxb12 sxb21 sxb22 sxb10 sxb01 hrf1 hrf2 hrs1 hrs2)
  2.   (if (/= xx "Left") 
  3.     (setq xx "Right" ang 0 ang0 (- ang 1.57079) ang2 (+ ang 1.57079)) 
  4.     (setq ang pi ang0 (+ ang 1.57079) ang2 (- ang 1.57079))
  5.   )
  6.   (setq sjd (cons (cadr jd) sjd) sjd (cons sx sjd))
  7.   (setq lh 235 lw 250 lbh 135 tz 20)
  8.   (setq tb0 sjd tb02 (polar tb0 ang tz))
  9.    (setq l3 (polar sjd ang lw))
  10.   (setq l13 (polar l3 (+ ang pi) width))
  11.   (setq pl nil pl (cons tb02 pl))
  12.   (setq hrf1 (polar tb0 1.57079 hg) hrs1 (polar hrf1 1.57079 hrl))
  13.   (repeat tw2
  14.     (setq tb1 (polar tb0 ang2 hg) tb12 (polar tb1 ang tz) tb12 (polar tb12 ang0 tz) pl (cons tb12 pl))
  15.     (setq tb2 (polar tb1 ang tw1) tb22 (polar tb2 ang0 tz) tb22 (polar tb22 ang tz) pl (cons tb22 pl))
  16.     (command "layer" "m" "sstair" "")
  17.     (command "LINE" tb0 tb1 tb2 "")
  18.     (setq tb0 tb2)
  19.   )
  20.   (setq hrf2 tb1 hrs2 (polar hrf2 1.57079 hrl))
  21.   (command "LINE" hrf1 hrs1 hrs2 hrf2 "")
  22.   (setq l4 (polar tb2 ang0 bho))
  23.   (setq l5 (polar l4 ang0 lh) l6 (polar l5 (+ ang pi) lw))
  24.   (setq l7 (polar tb2 (+ ang pi) lw) l7 (polar l7 ang0 (+ hg lbh)))
  25.   (setq l14 (polar l4 (+ ang pi) tz) l14 (polar l14 ang2 width2))
  26.   (setq l15 (polar l5 (+ ang pi) tz) l15 (polar l15 ang2 tz))
  27.   (setq l16 (polar l6 ang tz) l16 (polar l16 ang2 tz))
  28.   (setq l17 (polar l7 ang tz) l17 (polar l17 ang2 width))
  29.   (command "LINE" l4 l5 l6 l7 l3 "")
  30.   (command "PLINE" l14 "W" width2 width2 l15 l16 l17 "")
  31.   (if (tblsearch "LAYER" "SSTAIR1")
  32.     (command "layer" "t" "sstair1" "s" "sstair1" "")
  33.     (COMMAND "layer" "m" "sstair1" "")
  34.   )
  35.   (command "PLINE" l17 l13 "")
  36.     (newpoly pl)
  37.  
  38.     (setq sxb1 (polar tb2 ang (- t11 width2)))
  39.     (setq sxb2 (polar l4 ang (- t11 width2)))
  40.     (setq sxb22 (polar sxb2 ang2 tz) sxb22 (polar sxb22 ang 120)) 
  41.     (setq sxb11 (polar sxb1 ang0 tz) sxb11 (polar sxb11 ang 120))
  42.     (setq sxb21 (polar l4 ang2 tz) sxb21 (polar sxb21 (+ ang pi) width2))
  43.     (setq sxb10 (polar tb1 ang0 tz) sxb10 (polar sxb10 ang width2))
  44.     (setq sxb01 (polar sxb10 ang0 hg)) 
  45.   (command "layer" "m" "sban1" "")
  46.   (command "line" tb2 sxb1 "")
  47.   (command "layer" "s" "sstair" "")
  48.   (command "line" l4 sxb2 "")
  49.   (setq sxb2 (polar l5 ang (- t11 width2)))
  50.   (command "line" l5 sxb2  "")
  51.   (command "PLINE" sxb01 "W" width2 width2 sxb10 sxb11 "")
  52.   (command "pline" sxb21 sxb22 "")
  53.   (setq l0 tb1 tb1 (polar tb1 ang 100) l01 tb1) 
  54.   (repeat (1- tw3)
  55.   (setq l1 (polar tb1 ang2 tw1) l2 (polar l1 ang (- (+ t11 tw1) width2 100)) tb1 l1)
  56.   (command "line" l1 l2 "")
  57.   )
  58.   (setq l1 (polar tb1 ang2 tw1) l2 (polar l1 ang (- (+ t11 tw1) width2 100)))
  59.   (command "layer" "s" "sban1" "")
  60.   (command "line" l1 l2 "")
  61.   (command "layer" "s" "sstair" "")
  62.   (command "line" l01 l1 "")
  63.   (setq l2 (polar l1 (+ ang pi) 100))
  64.   (command "line" l1 l2 "")
  65.   (command "line" l0 l2 "") 
  66.   (setq tb0 l2 tb00 l2 pl nil)
  67.   (setq hrf1 (polar tb0 1.57079 hg) hrs1 (polar hrf1 1.57079 hrl))
  68.   (repeat tw2
  69.   (setq tb1 (polar tb0 ang2 hg) tb2 (polar tb1 (+ ang pi) tw1))
  70.   (setq tb01 (polar tb0 (+ ang pi) tz) tb01 (polar tb01 ang0 tz) pl (cons tb01 pl))
  71.   (setq tb11 (polar tb1 (+ ang pi) tz) tb11 (polar tb11 ang0 tz) pl (cons tb11 pl))
  72.   (setq tb12 (polar tb2 ang0 tz) pl (cons tb12 pl)) 
  73.   (command "layer" "s" "sstair" "")
  74.   (command "line" tb0 tb1 tb2 "")
  75.   (setq tb0 tb2)
  76.   )
  77.   (setq hrf2 tb1 hrs2 (polar hrf2 1.57079 hrl))
  78.   (command "LINE" hrf1 hrs1 hrs2 hrf2 "")
  79.   (setq l1 (polar tb1 ang0 (+ hg lbh)) l2 (polar l1 ang0 lh))
  80.   (setq l3 (polar l2 (+ ang pi) lw) l5 (polar tb2 ang0 bho) l4 (polar l5 ang (- tw1 lw)))
  81.   (setq l11 (polar l1 (+ ang pi) tz) l11 (polar l11 ang2 (+ tz tz)))
  82.   (setq l12 (polar l2 (+ ang pi) tz) l12 (polar l12 ang2 tz))
  83.   (setq l13 (polar l3 ang tz) l13 (polar l13 ang2 tz))
  84.   (setq l14 (polar l4 ang tz) l14 (polar l14 ang2 tz))
  85.   (setq l15 (polar l5 ang2 tz))
  86.   (setq l16 (polar tb1 ang0 hg) l16 (polar l16 (+ ang pi) tz))
  87.   (setq l17 (polar tb1 ang0 tz) l17 (polar l17 (+ ang pi) tz))
  88.   (setq l18 (polar tb2 ang0 tz))
  89.   (command "line" l1 l2 l3 l4 l5 "")
  90.   (setq l0 (polar tb00 ang0 lbh))
  91.   (command "line" l0 l1 "")
  92.   (setq l00 (polar l0 ang2 (+ tz tz)))
  93.   (command "pline" l11 l12 l13 l14 l15 "")
  94.   (command "pline" l16 l17 l18 "")
  95.   (if (tblsearch "LAYER" "SSTAIR2")
  96.     (command "layer" "t" "sstair2" "s" "sstair2" "")
  97.     (COMMAND "layer" "m" "sstair2" "")
  98.   )
  99.   (command "pline" l00 l11 "") 
  100.     (newpoly pl)
  101.     (setq se2 (entnext se))
  102.     (while (/= se2 nil)
  103.        (ssadd se2 ss)
  104.        (setq se2 (entnext se2))
  105.     )
  106.  )
  107.