home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / XB.LSP < prev    next >
Encoding:
Text File  |  1990-03-17  |  9.8 KB  |  201 lines
  1. ;**************************************
  2. ;*  The program for drawing           *
  3. ;**************************************
  4. ;(DEFUN XB ()
  5. (SETVAR "CMDECHO" 0)
  6. (MENUCMD "S=IN1")
  7. (setq fpt (getpoint "\n╙├ ╩« ╫╓ ╧▀ ╢¿ ╧│ ▒Γ ╞≡ ╩╝ ├µ: "))
  8. (setq dgl (getreal "\n╩Σ ╚δ ╞≡ ╩╝ ├µ ┤ª ╡╣ ╜╟=: "))
  9. (setq dr1 (getstring "\n╩Σ ╚δ ╕├ ╢╬ ╓▒ ╛╢=: "))
  10. (setq dr (atof dr1))
  11. (setq n (getreal "\n╩Σ ╚δ ╧│ ▒Γ ╩² =: "))
  12. (if (or (= n 2) (= n 4))(progn
  13. (setq a1 (getstring "\n╩Σ ╚δ ╧│ ▒Γ ┐φ ╢╚ =: "))
  14. (setq sch "" xch "" a (atof a1))
  15. ))
  16. (if (= n 6)(progn
  17. (setq fpt2 (getpoint "\n╙├ ╩« ╫╓ ╧▀ ╢¿ ╧ K ->  ╬╗ ╓├ "))
  18. ))
  19. (if (= n 4)(progn
  20. (while (or (< a (* 0.707 dr)) (>= a dr))
  21. (if (< a (* 0.707 dr))(setq a1 (getstring "\n┐φ ╢╚ ╠½ ╨í ! ╓╪ ╨┬ ╩Σ ╚δ ┐φ ╢╚=: ") a (atof a1)))
  22. (if (>= a dr)(setq a1 (getstring "\n┐φ ╢╚ ╠½ ┤≤ ! ╓╪ ╨┬ ╩Σ ╚δ ┐φ ╢╚=: ") a (atof a1)))
  23. )
  24. ))
  25. (setq yn (getstring "\n╙╨ ╖± ╣½ ▓ε (N)? "))
  26. (if (or (= yn "y") (= yn "Y"))(progn
  27.                               (setq sch (getstring "\n╔╧ ╞½ ▓ε=: "))
  28.                               (setq xch (getstring "\n╧┬ ╞½ ▓ε=: "))
  29.                               (setq xch (substr xch 2))
  30. ))
  31. (setq b1 (getstring "\n╩Σ ╚δ ╧│ ▒Γ │ñ ╢╚ =:  ( ╚⌠╗∙├µ╘┌╙╥,╩Σ╕║╓╡ ) "))
  32. (setq fpt1 (getpoint "\n╙├ ╩« ╫╓ ╧▀ ╢¿ ╧│ ▒Γ ╞╩ ├µ ═╝ ╬╗ ╓├: "))
  33. (setq xc (car  fpt) yc (cadr fpt) b (atof b1) atl dgl)
  34. (if (< b 0.)(setq dgl (- 0 dgl)))
  35. (if (/= dgl 0)(progn
  36. (command "erase" (list (+ xc dgl) (+ yc 2)) "")
  37. (command "erase" (list (+ xc dgl (* 0.1 dgl)) (+ yc 2)) "")
  38. (command "erase" (list (+ xc dgl (* 0.1 dgl)) (+ yc 2)) "")
  39. ))
  40. (if (or (= n 2) (= n 6))(progn
  41. (command "dim" "hor" (list xc  yc) (list (+ xc b) yc) (list (+ xc (/ b 2)) (- yc (/ dr 2) 20)) "1" "exit")
  42. ))
  43. (if (= n 4)(progn
  44. (command "dim" "hor" (list xc (- yc (/ dr 2))) (list (+ xc b) (- yc (/ dr 2))) (list (+ xc (/ b 2)) (- yc (/ dr 2) 20)) "1" "exit")
  45. ))
  46. (command "erase" "l" "")
  47. (command "line" (list  xc (- yc (/ dr 2) 20)) (list (+ xc b) (- yc (/ dr 2) 20)) "")
  48. (if (< b 0.)(setq b1 (substr b1 2)))
  49. (command "text" (list (- (+ xc (/ b 2)) 4) (- yc (/ dr 2) 18)) "4" "0" b1)
  50. (if (or (= n 2) (= n 4))(progn
  51. (command "pline" (list (+ xc (/ b 2)) (+ yc (/ dr 2) 8)) "w" "1" "1" (list (+ xc (/ b 2)) (+ yc (/ dr 2) 4)) "")
  52. (command "pline" (list (+ xc (/ b 2)) (- yc (/ dr 2) 3)) (list (+ xc (/ b 2)) (- yc (/ dr 2) 7)) "")
  53. (command "text" (list (+ xc (/ b 2) 3) (+ yc (/ dr 2) 10)) "5" "0" "F")
  54. (command "text" (list (+ xc (/ b 2) 3) (- yc (/ dr 2) 12)) "5" "0" "F")
  55. (setq c (/ (* dr dr) 4) d (/ (* a a) 4))
  56. (setq h (sqrt (- c d)))
  57. (setq ll1 0 ll2 0)
  58. (if (/= sch "")(setq ll1 (strlen sch)))
  59. (if (/= xch "")(setq ll2 (strlen xch)))
  60. (setq nn (strlen a1))
  61. (setq ll (max ll1 ll2) ll (* (+ ll nn 1) 4))
  62.  ))
  63. (if (= n 2)(progn
  64.            (setq tof (list xc (+ yc h)))
  65.            (setq bof (list xc (- yc h)))
  66.            (setq toe (list (+ xc b) (+ yc h)))
  67.            (setq boe (list (+ xc b) (- yc h)))
  68.            (setq botl (list xc (+ (- yc (/ dr 2)) atl)))
  69.            (setq botr (list (+ xc dgl) (- yc (/ dr 2))))
  70.            (setq bog (list (+ xc dgl) (- yc h)))
  71.            (setq tog (list (+ xc dgl) (+ yc h)))
  72.            (setq topl (list xc (- (+ yc (/ dr 2)) atl)))
  73.            (setq topr (list (+ xc dgl) (+ yc (/ dr 2))))
  74. (if (/= dgl 0)(command "pline" tof "w" "0.35" "0.35" topl topr tog tof toe boe bog botr botl bof bog ""))
  75. (if (= dgl 0)(command "pline" tof "w" "0.35" "0.35" toe boe bof tof ""))
  76. (command "line" tof boe "")
  77. (command "line" bof toe "")
  78. (redraw)
  79. (setq xc (car fpt1) yc (cadr fpt1))
  80. (setq xc1 (- xc (/ a 2)) yc1 (+ yc h) xc2 (+ xc (/ a 2)))
  81. (setq ycc1 (- yc h))
  82. (command "pline" (list xc1 yc1) (list xc1 ycc1) "arc" "second" (list xc (- yc (/ dr 2))) (list xc2 ycc1) "l" (list xc2 yc1) "arc" "second" (list xc (+ yc (/ dr 2))) (list xc1 yc1) "")
  83. (command "hatch" "u" "45" "5" "" "l" "")
  84. (command "layer" "s" "1" "")
  85. (command "line" (list (- xc1 3) yc) (list (+ xc2 3) yc) "")
  86. (command "line" (list xc (+ yc (/ dr 2) 3)) (list xc (- yc (/ dr 2) 3)) "")
  87. (command "layer" "s" "0" "")
  88. (command "dim" "hor" (list xc1 yc1) (list xc2 yc1) (list xc (+ yc (/ dr 2) 10)) "o" "exit")
  89. (command "erase" "l" "")
  90. (command "line" (list  xc1 (+ yc (/ dr 2) 10)) (list xc2 (+ yc (/ dr 2) 10)) "")
  91. (if (> a ll)(setq fg (list (+ xc1 (/ (- a ll) 2) 4) (+ yc 12 (/ dr 2)))))
  92. (if (<= a ll)(setq fg (list (+ xc2 5) (+ yc 12 (/ dr 2)))))
  93. (command "text" fg "4" "0" a1)
  94. (if (= nn 2)(setq fg (list (+ (car fg) 8) (cadr fg))))
  95. (if (/= sch "")(progn
  96.                (command "text" (list (car fg) (+ (cadr fg) 2.5)) "2" "0" "+")
  97.                (command "text" (list (+ (car fg) 2) (+ (cadr fg) 2.5)) "2" "0" sch)
  98. ))
  99. (if (/= xch "")(progn
  100.                (command "text" (list (car fg) (cadr fg)) "2" "0" "-")
  101.                (command "text" (list (+ (car fg) 2) (cadr fg)) "2" "0" xch)
  102. ))
  103. ))
  104. (if (= n 4)(progn
  105.   (setq rr (sqrt (- (* dr dr) (* a a))))
  106.   (setq x1 (* 0.3535 (- a rr)))
  107.   (setq y1 (- (* 0.707 a) x1))
  108.   (setq tof (list (+ xc b) (+ yc (/ dr 2))))
  109.   (setq topl (list (+ xc b) (+ yc x1)))
  110.   (setq toe (list (+ xc dgl) (+ yc x1)))
  111.   (setq topr (list xc (+ yc x1)))
  112.   (setq botr (list xc (- yc x1)))
  113.   (setq boe (list (+ xc dgl) (- yc x1)))
  114.   (setq botl (list (+ xc b) (- yc x1)))
  115.   (setq bof (list (+ xc b) (- yc (/ dr 2))))
  116.   (command "pline" tof "w" "0.35" "0.35" topl topr toe boe botr botl bof "")
  117.   (setq xc (car fpt1) yc (cadr fpt1))
  118.    (command "pline" (list (- xc x1) (+ yc y1)) "arc" "second" (list xc (+ yc (/ dr 2))) (list (+ xc x1) (+ yc y1)) "l" (list (+ xc y1) (+ yc x1)) "")
  119.    (command "array" "l" "" "c" (list xc yc) "90" "4" "y")
  120.   (command "hatch" "u" "45" "5" "" "w" (list (- xc (/ dr 2) 1) (- yc (/ dr 2) 1)) (list (+ xc (/ dr 2) 1) (+ yc (/ dr 2) 1)) "")
  121.   (command "circle" fpt1 (/ dr 2))
  122.   (command "layer" "s" "1" "")
  123.   (command "line" (list (- xc (/ dr 2) 3) yc) (list (+ xc (/ dr 2) 3) yc) "")
  124.   (command "line" (list xc (+ yc (/ dr 2) 3)) (list xc (- yc (/ dr 2) 3)) "")
  125.   (command "layer" "s" "0" "")
  126.   (setq ll (- ll 4))
  127.   (if (> a ll)(setq fg (list (+ xc (- (* 0.707 (+ (/ dr 2) 10)) (* 0.707 (/ ll 2)))) (+ yc (* 0.707 (+ (/ dr 2) 10)) (* 0.707 (/ ll 2))))))
  128.   (if (<= a ll)(setq fg (list (+ xc (* 0.707 (+ (/ dr 2) 10)) (* 0.707 (/ a 2))) (+ yc (- (* 0.707 (+ (/ dr 2) 10)) (* 0.707 (/ a 2)))))))
  129.   (command "dim" "rotated" "315" (list (- xc x1) (+ yc y1)) (list (+ xc x1) (- yc y1)) fg "1" "exit")
  130. (command "erase" "l" "")
  131.   (setq ff (+ (/ dr 2) 10))
  132. (setq fh (list (+ (- xc x1) (* 0.707 (- ff (/ rr 2)))) (+ (+ yc y1) (* 0.707 (- ff (/ rr 2))))))
  133. (setq fk (list (+ (+ xc x1) (* 0.707 (+ ff (/ rr 2)))) (+ (- yc y1) (* 0.707 (+ ff (/ rr 2))))))
  134. (command "line" fh fk "")
  135.   (if (> a ll)(setq fg (list (+ xc (- (* 0.707 (+ (/ dr 2) 12)) (* 0.707 (/ ll 2)))) (+ yc (* 0.707 (+ (/ dr 2) 12)) (* 0.707 (/ ll 2))))))
  136.   (if (<= a ll)(setq fg (list (+ xc (* 0.707 (+ (/ dr 2) 12)) (* 0.707 (/ a 2))) (+ yc (- (* 0.707 (+ (/ dr 2) 12)) (* 0.707 (/ a 2)))))))
  137.   (command "text" fg "4" "315" a1)
  138. (if (= nn 2)(setq fg (list (+ (car fg) 5.7) (- (cadr fg) 5.7))))
  139. (if (/= sch "")(progn
  140.                (command "text" (list (+ (car fg) 1.8) (+ (cadr fg) 1.8)) "2" "315" "+")
  141.                (command "text" (list (+ (car fg) 3.3) (- (cadr fg) 0.5)) "2" "315" sch)
  142. ))
  143. (if (/= xch "")(progn
  144.                (command "text" (list (- (car fg) 0.7) (- (cadr fg) 0.7)) "2" "315" "-")
  145.                (command "text" (list (+ (car fg) 0.8) (- (cadr fg) 2.2)) "2" "315" xch)
  146. ))
  147. ))
  148. (if (= n 6)(progn
  149.   (setq x1 (+ xc b) x2 (+ xc dgl) y1 (+ yc (/ dr 2)) y2 (- yc (/ dr 2)) y3 (+ yc (/ dr 4)) y4 (- yc (/ dr 4)) ) 
  150. (command "pline" (list x1 y1) "w" "0.35" "" (list x1 y2) "")
  151. (command "pline" (list x1 y3) "w" "0.35" "" (list x2 y3) "")
  152. (command "pline" (list x1 y4) "w" "0.35" "" (list x2 y4) "")
  153. (command "pline" (list x2 y1) "w" "0.35" "" "arc" "sec" (list xc (- y1 (/ dr 8))) (list x2 y3) "sec" (list xc yc) (list x2 y4) "sec" (list xc (+ y2 (/ dr 8))) (list x2 y2) "")
  154.   (setq xc (car fpt2) yc (cadr fpt2))
  155. (if (< b 0)(progn
  156. (command "pline" (list xc yc) "w" "0" "1.2" (list (+ xc 4) yc) "")
  157. (command "line" (list (+ xc 4) yc) (list (+ xc 8) yc) "")
  158. (command "text" (list (+ xc 11) (- yc 2)) "5" "0" "K")
  159. ))
  160. (if (> b 0)(progn
  161. (command "pline" (list xc yc) "w" "0" "1.2" (list (- xc 4) yc) "")
  162. (command "line" (list (- xc 4) yc) (list (- xc 8) yc) "")
  163. (command "text" (list (- xc 14) (- yc 2)) "5" "0" "K")
  164. ))
  165.   (setq xc (car fpt1) yc (cadr fpt1))
  166. (setq r1 (* 0.433 dr))
  167. (setq p1 (list (- xc r1) (+ yc (/ dr 4))))
  168. (setq p2 (list xc (+ yc (/ dr 2))))
  169. (setq p3 (list (+ xc r1) (+ yc (/ dr 4))))
  170. (setq p4 (list (+ xc r1) (- yc (/ dr 4))))
  171. (setq p5 (list xc (- yc (/ dr 2))))
  172. (setq p6 (list (- xc r1) (- yc (/ dr 4))))
  173.   (command "layer" "s" "1" "")
  174.   (command "line" (list (- xc r1 3) yc) (list (+ xc r1 3) yc) "")
  175.   (command "line" (list xc (+ yc (/ dr 2) 3)) (list xc (- yc (/ dr 2) 3)) "")
  176.   (command "layer" "s" "0" "")
  177. (command "pline" p1 "w" "0.35" "" p2 p3 p4 p5 p6 p1 "")
  178. (command "pline" (list xc (+ yc r1)) "a" "ce" (list xc yc) "a" "180" "cl")
  179. (command "dim" "hor" p6 p4 (list xc (- yc (/ dr 2) 15)) "1" "exit")
  180. (command "erase" "l" "")
  181. (command "line" (list  (- xc r1) (- yc (/ dr 2) 15)) (list (+ xc r1) (- yc (/ dr 2) 15)) "")
  182. (setq r2 (/ (fix (* 10 (+ 0.05 (* r1 2)))) 10))
  183. (command "text" (list (- xc 4) (- yc (/ dr 2) 10)) "4" "0" r2)
  184. (command "dim" "vert" p2 p5 (list (+ xc r1 15) yc) "1" "exit")
  185. (command "erase" "l" "")
  186. (command "line" (list  (+ xc r1 15) (+ yc (/ dr 2))) (list (+ xc r1 15) (- yc (/ dr 2))) "")
  187. (command "text" (list (+ xc r1 10) (- yc 5)) "4" "90" dr1)
  188. ))
  189. (if (or (= n 2) (= n 4))(progn
  190. (command "text" (list (- xc 8) (+ yc (/ dr 2) 22)) "5" "0" "F")
  191. (command "pline" (list (- xc 3) (+ yc (/ dr 2) 25)) "w" "0.4" "0.4" (list (+ xc 1) (+ yc (/ dr 2) 25)) "")
  192. (command "text" (list (+ xc 4) (+ yc (/ dr 2) 22)) "5" "0" "F")
  193. ))
  194. (if (= n 6)(progn
  195. (command "insert" "kx" (list xc (+ yc (/ dr 2) 18)) "0.5" "" "0")
  196. ))
  197. (MENUCMD "S=SCREEN")
  198. (redraw)
  199. ;)
  200. ;(XB)
  201.