home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / SST.LSP < prev    next >
Encoding:
Text File  |  1992-02-18  |  7.9 KB  |  185 lines
  1. (defun SST (/ a pt1 pt2 li lay li lay rn wl loop ll x xx ltlx t11 t12 tw1 tw2 tw3 n n0 sk  sk2 sx tl ag ag2 jo hg th bg kw hrl)
  2.     (setq a 0)
  3.     (while (<= a (1- sl))
  4.        (setq sn (ssname sj a) pt1 nil pt2 nil bg 0 ltlx nil)
  5.        (setq s1 (entget sn) li (cdr (assoc 0 s1)) lay (cdr (assoc 8 s1)))
  6.        (if (and (eq li "INSERT") (eq lay "PSTAIR")) (progn
  7.           (redraw sn 3)
  8.          (setq ne (entnext sn) s2 (entget ne)) 
  9.          (if (= (type s2) 'LIST) (PROGN
  10.          (setq in (cdr (assoc 11 s2)))  
  11.           (SETQ rn (cdr (assoc 1 s2)) wl nil loop t)
  12.           (while loop 
  13.            (setq ll (instr 1 rn " "))
  14.            (if (= ll 0) (setq wl (cons rn wl) loop nil)
  15. (setq x (substr rn 1 (1- ll)) wl (cons x wl) rn (substr rn (1+ ll) (- (strlen rn) ll)) loop t)
  16.            )
  17.           )
  18.       (setq wl (reverse wl))
  19.       (setq ltlx (nth 0 wl))
  20.  (cond ((= ltlx "T1")
  21.        (setq t11 (nth 1 wl) t12 (atoi (nth 2 wl)) tw1 (atoi (nth 3 wl)))
  22.        (setq tw2 (atoi (nth 4 wl)) ag (atof (nth 5 wl)) hg (atoi (nth 6 wl)) th (atoi (nth 7 wl)) hrl (atoi (nth 8 wl)))
  23.        (load "lisp\\sub") (sub11 t11)
  24.        (setq t11 axdl n (length t11) n0 0 sk 0)
  25.        (while (< n0 n)
  26.          (setq sk (+ (nth n0 t11) sk) n0 (1+ n0))
  27.        )
  28.        (setq sk2 (/ sk n))  
  29.        (setq tl (+ t12 (* tw1 tw2))) 
  30.        (setq ag2 (- ag (/ pi 2.0)))
  31.        (setq pt1 (polar in ag2 tl))
  32.        (setq pt2 (polar pt1 ag sk))
  33.        (setq jo (inters p1 p2 pt1 pt2)) 
  34.        (if (= (type jo) 'LIST) (progn
  35.          (if (eq fg "Col") (setq pt1 (cadr jo) pt2 (cadr in)) 
  36.                            (setq pt1 (car jo) pt2 (car in))
  37.          ) 
  38.  (if (and (> n 1) (or
  39.                   (and (eq px "L") 
  40.                    (or (and (> pt2 pt1) (< (abs (- (car jo) (car in))) sk2))
  41.                        (and (< pt2 pt1) (> (abs (- (car jo) (car in))) sk2))
  42.                   ))
  43.                   (and (eq px "R")
  44.                    (or (and (> pt2 pt1) (> (abs (- (car jo) (car in))) sk2))
  45.                        (and (< pt2 pt1) (< (abs (- (car jo) (car in))) sk2))
  46.                   ))
  47.                   (and (eq px "U") 
  48.                    (or (and (> pt2 pt1) (< (abs (- (cadr jo) (cadr in))) sk2))
  49.                        (and (< pt2 pt1) (> (abs (- (cadr jo) (cadr in))) sk2))
  50.                   ))
  51.                   (and (eq px "D")
  52.                    (or (and (> pt2 pt1) (> (abs (- (cadr jo) (cadr in))) sk2))
  53.                        (and (< pt2 pt1) (< (abs (- (cadr jo) (cadr in))) sk2))
  54.                   ))
  55.                   )
  56.        )
  57.            (progn (setq bg 1) (princ "\n╕├┬Ñ╠▌╞╩╟╨╬╗╓├▓╗╢╘,╞╩├µ═╝╓╨╬▐╕├┬Ñ╠▌!"))
  58.  ) 
  59.          (setq sx (+ (car jd) (abs (- pt1 ymin))))
  60.                                 )
  61.        )
  62.        (if (and (= (type jo) 'LIST) (= bg 0)) (progn 
  63.          (if (or (eq px "L") (eq px "U"))
  64.            (if (> pt1 pt2) (setq xx "Left") (setq xx "Right"))
  65.            (if (> pt1 pt2) (setq xx "Right") (setq xx "Left"))
  66.          )            
  67.          (load "lisp\\lt1") (lt1)
  68.        ))
  69.            (redraw sn 4)
  70.     )
  71.     ((= ltlx "T2")
  72.        (setq t11 (atoi (nth 1 wl)) tw1 (atoi (nth 2 wl)) tw2 (atoi (nth 3 wl)))
  73.        (setq tw3 (atoi (nth 4 wl)) ag (atof (nth 5 wl)) hg (atoi (nth 6 wl)) th (atoi (nth 7 wl)) hrl (atoi (nth 8 wl)))
  74.        (setq tl (+ t11 (* tw1 tw2))) 
  75.        (setq sk (+ t11 t11 (* tw1 tw3))) 
  76.        (setq ag2 (- ag (/ pi 2.0)))
  77.        (setq pt1 (polar in ag2 tl))
  78.        (setq pt2 (polar pt1 ag sk))
  79.        (setq jo (inters p1 p2 pt1 pt2))
  80.        (if (= (type jo) 'LIST) (progn
  81.          (if (eq fg "Col") (setq pt1 (cadr jo) pt2 (cadr in)) 
  82.                            (setq pt1 (car jo) pt2 (car in))
  83.          )
  84.        (if (or (and (eq px "L") 
  85.                 (or (and (> pt2 pt1) (< (abs (- (car jo) (car in))) t11))
  86.                     (and (< pt2 pt1) (> (abs (- (car jo) (car in))) t11))
  87.                ))
  88.                (and (eq px "R")
  89.                 (or (and (> pt2 pt1) (> (abs (- (car jo) (car in))) t11))
  90.                     (and (< pt2 pt1) (< (abs (- (car jo) (car in))) t11))
  91.                ))
  92.                (and (eq px "U") 
  93.                 (or (and (> pt2 pt1) (< (abs (- (cadr jo) (cadr in))) t11))
  94.                     (and (< pt2 pt1) (> (abs (- (cadr jo) (cadr in))) t11))
  95.                ))
  96.                (and (eq px "D")
  97.                 (or (and (> pt2 pt1) (> (abs (- (cadr jo) (cadr in))) t11))
  98.                     (and (< pt2 pt1) (< (abs (- (cadr jo) (cadr in))) t11))
  99.                ))
  100.             )
  101.            (progn (setq bg 1) (princ "\n╕├┬Ñ╠▌╞╩╟╨╬╗╓├▓╗╢╘,╞╩├µ═╝╓╨╬▐╕├┬Ñ╠▌!"))
  102.        ) 
  103.          (setq sx (+ (car jd) (abs (- pt1 ymin))))
  104.                                 )
  105.        )
  106.        (if (and (= (type jo) 'LIST) (= bg 0)) (progn 
  107.          (if (or (eq px "L") (eq px "U"))
  108.            (if (> pt1 pt2) (setq xx "Left") (setq xx "Right"))
  109.            (if (> pt1 pt2) (setq xx "Right") (setq xx "Left"))
  110.          )            
  111.        (load "lisp\\lt2") (lt2)
  112.        ))
  113.            (redraw sn 4)
  114.    )
  115.    ((= ltlx "T3") 
  116.      (setq kw (nth 1 wl) t11 (atoi (nth 2 wl)) t12 (atoi (nth 3 wl)) tw1 (atoi (nth 4 wl)))
  117.      (setq tw2 (atoi (nth 5 wl)) tw3 (atoi (nth 6 wl)) ag (atof (nth 7 wl)) hg (atoi (nth 8 wl)) th (atoi (nth 9 wl)) hrl (atoi (nth 10 wl)))
  118.        (setq tl (+ t12 (* tw1 tw2))) 
  119.        (setq ag2 (- ag (/ pi 2.0)))
  120.        (setq pt1 (polar in ag2 tl))
  121.        (setq pt2 (polar pt1 ag t11))
  122.        (if (= kw "Yes") (setq pt1 (polar pt1 (- pi ag) t11)))
  123.        (setq jo (inters p1 p2 pt1 pt2))
  124.        (if (= (type jo) 'LIST) (progn
  125.          (if (eq fg "Col") (setq pt1 (cadr jo) pt2 (cadr in)) 
  126.                            (setq pt1 (car jo) pt2 (car in))
  127.          )
  128. ;       (if (or (and (eq px "L") 
  129. ;                (or (and (> pt2 pt1) (< (abs (- (car jo) (car in))) t11))
  130. ;                    (and (< pt2 pt1) (> (abs (- (car jo) (car in))) t11))
  131. ;               ))
  132. ;               (and (eq px "R")
  133. ;                (or (and (> pt2 pt1) (> (abs (- (car jo) (car in))) t11))
  134. ;                    (and (< pt2 pt1) (< (abs (- (car jo) (car in))) t11))
  135. ;               ))
  136. ;               (and (eq px "U") 
  137. ;                (or (and (> pt2 pt1) (< (abs (- (cadr jo) (cadr in))) t11))
  138. ;                    (and (< pt2 pt1) (> (abs (- (cadr jo) (cadr in))) t11))
  139. ;               ))
  140. ;               (and (eq px "D")
  141. ;                (or (and (> pt2 pt1) (> (abs (- (cadr jo) (cadr in))) t11))
  142. ;                    (and (< pt2 pt1) (< (abs (- (cadr jo) (cadr in))) t11))
  143. ;               ))
  144. ;            )
  145. ;           (progn (setq bg 1) (princ "\n╕├┬Ñ╠▌╞╩╟╨╬╗╓├▓╗╢╘,╞╩├µ═╝╓╨╬▐╕├┬Ñ╠▌!"))
  146. ;       ) 
  147.          (setq sx (+ (car jd) (abs (- pt1 ymin))))
  148.                                 )
  149.        )
  150.        (if (and (= (type jo) 'LIST) (= bg 0)) (progn 
  151.          (if (or (eq px "L") (eq px "U"))
  152.            (if (> pt1 pt2) (setq xx "Left") (setq xx "Right"))
  153.            (if (> pt1 pt2) (setq xx "Right") (setq xx "Left"))
  154.          )            
  155.      (load "lisp\\lt3") (lt3)
  156.          ))
  157.            (redraw sn 4)
  158.      )
  159.     ((= ltlx "T4")
  160.        (setq t11 (atof (nth 1 wl)) tw2 (atoi (nth 2 wl)))
  161.        (if (eq fg "Col") (setq pt1 (cadr in))
  162.                          (setq pt1 (car in)))
  163.        (if (or (and (eq fg "Col") (< (abs (- (car p1) (car in))) tw2) 
  164.                                   (< (abs (- (car p2) (car in))) tw2))
  165.                (and (eq fg "Row") (< (abs (- (cadr p1) (cadr in))) tw2)
  166.                                   (< (abs (- (cadr p2) (cadr in))) tw2))) 
  167.          (progn (load "lisp/lt4") (lt4))
  168.        )
  169.            (redraw sn 4)
  170.             )
  171.       )  
  172.                                  )
  173.          )
  174.                                                       )
  175.        )
  176.       (setq a (1+ a))
  177.      )
  178. )
  179.  
  180. (defun newpoly (vrtlst / n)
  181.       (setq vrtlst (reverse vrtlst) vrtlst (cons "PLINE" vrtlst))
  182.       (foreach n vrtlst (command n))
  183.       (command) 
  184. )
  185.