home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / TJES.LSP < prev    next >
Encoding:
Text File  |  1992-02-01  |  5.4 KB  |  156 lines
  1. (vmon)
  2.  
  3. (defun tjerr(s)
  4.    (if (/= s "Function cancelled")
  5.        (princ (strcat "\nError:" s))
  6.    )
  7.    (command "layer" "s" "0" "")
  8.    (setvar "cmdecho" 1)
  9.    (setvar "osmode" 0)
  10.    (setq *error* oer)
  11.    (princ)
  12. )
  13.  
  14. (defun C:TJS(/ oer stw sth stn sp lr ss sn ang lw pl p1 p2 n l)
  15.    (setvar "cmdecho" 0)
  16.    (setq oer *error* *error* tjerr)
  17.    (setq stw (getint "\n╠ñ▓╜┐φ <175>:"))
  18.    (if (= stw nil) (setq stw 175))
  19.    (setq sth (getint "\n╠ñ▓╜╕▀ <150>:"))
  20.    (if (= sth nil) (setq sth 150))
  21.    (setq stn (getint "\n╠ñ▓╜╩² <3>:"))
  22.    (if (= stn nil) (setq stn 3))
  23.    (setvar "osmode" 1)
  24.    (setq sp (getpoint "\n╞≡╩╝╡π:"))
  25.    (setvar "osmode" 0)
  26.    (setq lr (getstring "\n╫≤├µL/╙╥├µ <R>:"))
  27.    (if (/= (strcase lr) "L") (setq lr "R" ang 0) (setq ang pi))
  28.    (setq ss (ssget sp))
  29.    (setq lw (* 0.5 (getvar "userr1")))
  30.    (if ss (progn
  31.    (setq sn (ssname ss 0) en (entget sn) ename (cdr (assoc 0 en)))
  32.    (if (= ename "POLYLINE") (setq lw (cdr (assoc 40 en))))
  33.    ))
  34.    (command "layer" "m" "sother" "")
  35.    (setq pl nil pl (cons sp pl))
  36.    (repeat stn
  37.       (setq p1 (polar sp ang stw) p2 (polar p1 (* 1.5 pi) sth))
  38.       (setq pl (cons p1 pl) pl (cons p2 pl))
  39.       (setq sp p2)
  40.    )
  41.    (setq p2 (polar p2 ang (* 25 (getvar "userr1"))))
  42.    (setq pl (cons p2 pl))
  43.    (setq n 1 l (length pl))
  44.    (command "pline" (nth 0 pl) "w" lw "")
  45.    (repeat (1- l)
  46.       (command (nth n pl))
  47.       (setq n (1+ n))
  48.    )
  49.    (command)
  50.    (command "layer" "s" "0" "")
  51.    (setvar "cmdecho" 1)
  52.    (setq *error* oer)
  53.    (princ)
  54. )
  55.  
  56. (defun C:TJE(/ oer terh s1 tw tw1 tw2 tw0 tl1 tl2 axdl x p ang)
  57.    (setvar "cmdecho" 0)
  58.    (setq oer *error* *error* tjerr)
  59.    (setq s1 (getstring "\n╩Σ╚δ╠¿╜╫╩╜╤∙3/2/1/<0>:"))
  60.    (if (= s1 "") (setq s1 "0"))
  61.    (if (and (>= s1 "0") (<= s1 "3")) (progn
  62.    (cond ((= s1 "0") (setq tw2 1 tl1 (getint "\n╩Σ╚δ╞┬╡└│ñ╢╚ <3600>:"))
  63.                      (if (= tl1 nil) (setq tl1 3600))
  64.                      (setq tw (getint "\n╩Σ╚δ╞┬╡└╖┼╞┬╛α└δ <600>:"))
  65.                      (if (= tw nil) (setq tw 600)))
  66.          ((= s1 "1") (setq tl1 (getint "\n╩Σ╚δ╠¿╜╫│ñ╢╚ <3600>:"))
  67.                      (if (= tl1 nil) (setq tl1 3600))
  68.                      (setq tw (getint "\n╩Σ╚δ╠ñ▓╜┐φ <175>:"))
  69.                      (if (= tw nil) (setq tw 175))
  70.                      (setq tw2 (getint "\n╩Σ╚δ╠ñ▓╜╕÷╩² <3>:"))
  71.                      (if (= tw2 nil) (setq tw2 3)))
  72.          ((= s1 "2") (setq tl1 (getint "\n╩Σ╚δ╠¿╜╫│ñ╢╚ <3600>:"))
  73.                      (if (= tl1 nil) (setq tl1 3600))
  74.                      (setq tw2 (getint "\n╩Σ╚δ╠ñ▓╜╕÷╩² <3>:"))
  75.                      (if (= tw2 nil) (setq tw2 3)))
  76.          ((= s1 "3") (setq tl1 (getint "\n╩Σ╚δ╠¿╜╫│ñ╢╚ <3600>:"))
  77.                      (if (= tl1 nil) (setq tl1 3600))
  78.                      (setq tw (getint "\n╩Σ╚δ╠ñ▓╜┐φ <175>:"))
  79.                      (if (= tw nil) (setq tw 175))
  80.                      (setq tw2 (getint "\n╩Σ╚δ╠ñ▓╜╕÷╩² <3>:"))
  81.                      (if (= tw2 nil) (setq tw2 3)))
  82.     )
  83.    (setq terh (getint "\n╩Σ╚δ╠ñ▓╜╕▀╢╚ <150>:"))
  84.    (if (= terh nil) (setq terh 150))
  85.    (graphscr)
  86.    (initget "R")
  87.    (setq p (getpoint "\n▓╬┐╝╡πR/<▓σ╚δ╓╨╡π>:"))
  88.    (if (= p "R") (progn (setq p (getpoint "\n▓╬┐╝╡π:"))
  89.                  (setq p (getpoint p "\n▓σ╚δ╓╨╡π:"))))
  90.    (setq ang 0 p (polar p pi (/ tl1 2.0)))
  91.    (command "layer" "m" "eother" "")
  92.    (cond ((= s1 "0") (tje1 tl1 tw terh p ang))
  93.          ((= s1 "1") (tje2 tl1 tw terh tw2 p ang))
  94.          ((= s1 "2") (tje3 tl1 tw terh tw2 p ang))
  95.          ((= s1 "3") (tje4 tl1 tw terh tw2 p ang))
  96.    )
  97.    ))
  98.    (command "layer" "s" "0" "")
  99.    (setvar "cmdecho" 1)
  100.    (setq *error* oer)
  101.    (princ)
  102. )
  103.  
  104. (defun tje1(tl11 tw1 tw11 p1 ang1 / p2 p3 p4 p5 p6)
  105.                       (setq p2 (polar p1 (+ ang1 1.57079) tw11))
  106.                       (setq p3 (polar p2 ang1 tl11))
  107.                       (setq p4 (polar p3 (- ang1 1.57079) tw11))
  108.                       (setq p5 (polar p2 ang1 tw1) p6 (polar p3 (+ ang1 pi) tw1))
  109.                       (command "pline" p5 "w" 0 "" p1 p4 p6 "c")
  110. )
  111.  
  112. (defun tje2(tl11 tw1 tw11 tw22 p1 ang1 / ang2 p2 p3 p4)
  113.    (setq ang2 (+ ang1 1.57079))
  114.    (repeat tw22
  115.       (setq p2 (polar p1 ang1 tl11))
  116.       (setq p3 (polar p1 ang2 tw11) p4 (polar p2 ang2 tw11))
  117.       (command "pline" p1 "w" 0 "" p3 p4 p2 "")
  118.       (setq p1 (polar p3 ang1 tw1) tl11 (- tl11 (* 2 tw1)))
  119.    )
  120. )
  121.  
  122. (defun tje3(tl11 tw1 tw11 tw22 p1 ang1 / p2 ang2)
  123.    (setq ang2 (+ ang1 1.57079))
  124.    (repeat (1+ tw22)
  125.       (setq p2 (polar p1 ang1 tl11))
  126.       (command "pline" p1 "w" 0 "" p2 "")
  127.       (setq p1 (polar p1 ang2 tw11))
  128.    )
  129. )
  130.  
  131. (defun tje4(tl11 tw1 tw11 tw22 p1 ang1 / ang2 p2 p3 p4)
  132.    (setq ang2 (+ ang1 1.57079))
  133.    (repeat tw22
  134.       (setq p2 (polar p1 ang1 tl11))
  135.       (setq p3 (polar p1 ang2 tw11) p4 (polar p2 ang2 tw11))
  136.       (command "pline" p1 "w" 0 "" p3 p4 p2 "")
  137.       (setq p1 (polar p3 ang1 tw1) tl11 (- tl11 tw1))
  138.    )
  139. )
  140.  
  141. (defun C:YUG(/ oer sp ep lw p1 p2 p3 p4)
  142.    (setvar "cmdecho" 0)
  143.    (setq oer *error* *error* tjerr)
  144.    (setq sp (getpoint "\n╙Ω┬Σ╣▄╞≡╡π:"))
  145.    (setq ep (getpoint sp "\n╙Ω┬Σ╣▄╓╒╡π:"))
  146.    (setq lw (getvar "userr1"))
  147.    (setq p1 (polar sp 0 (* 0.5 lw)) p2 (polar sp pi (* 0.5 lw)))
  148.    (setq p3 (polar ep 0 (* 0.5 lw)) p4 (polar ep pi (* 0.5 lw)))
  149.    (command "layer" "m" "eother" "")
  150.    (command "pline" p1 "w" 0 "" p2 p4 p3 "c")
  151.    (command "layer" "s" "0" "")
  152.    (setvar "cmdecho" 1)
  153.    (setq *error* oer)
  154.    (princ)
  155. )
  156.