home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / HM22.LSP < prev    next >
Encoding:
Text File  |  1990-03-21  |  6.3 KB  |  176 lines
  1. (DEFUN CENLINE1 ()
  2. (MENUCMD "S=IN2")
  3. (INITGET "Y N")
  4. (SETQ YN (GETKWORD "\n╩╟╦«╞╜╖╜╧≥╡─┐╫┬≡? (Y) "))
  5. (IF (= YN "N") (SETQ BAT 2) (SETQ BAT 1))
  6. (COMMAND "OSNAP" "NEAREST")
  7. (setq str1 (getpoint "\n╙├ ╩« ╫╓ ╧▀ ╢¿ ╗∙ ├µ ╬╗ ╓├: "))
  8. ;(setq str1 (osnap str "nea"))
  9. (setq x1 (car str1) y1 (cadr str1) sc 0)
  10. ;(if (= (fix y1) (fix yb))(setq bat 1)(setq bat 2))
  11. (MENUCMD "S=IN1")
  12. (setq l (getreal "\n╡╜ ╗∙ ├µ ╛α └δ=: "))
  13. (setq FPT (getpoint "\n╙├ ╩« ╫╓ ╧▀ ╢¿ ╞≡ ╩╝ ├µ:"))
  14. ;(setq fpt (osnap str "nea"))
  15. (setq xg (car fpt) yf (cadr fpt) l1 l l (* l s))
  16. (setq ept (getpoint "\n╙├ ╩« ╫╓ ╧▀ ╢¿ ╓╒ ╓╣ ├µ: "))
  17. (COMMAND "OSNAP" "NONE")
  18. (setq xe (car ept) ye (cadr ept) ll 1 lk 0)
  19. (if (= bat 2)(progn
  20. (if (> yf ye)(setq sc bat))
  21. (if (< yf ye)(setq sc (+ bat 3)))
  22. ))
  23. (if (= bat 1)(progn
  24. (if (> xe xg)(setq sc bat))
  25. (if (< xe xg)(setq sc (+ bat 3)))
  26. ))
  27. (if (or (= sc 1) (= sc 2))(setq tg 0.1)(setq tg (- 0 0.1)))
  28. (if (or (= sc 1) (= sc 4))(setq tof (list (- xg tg) (+ yb l)) toe (list (+ xe tg) (+ yb l))))
  29. (if (or (= sc 2) (= sc 5))(setq tof (list (+ x1 l) (+ yf tg)) toe (list (+ x1 l) (- ye tg))))
  30. (if (and (= yf ye) (= xg xe))(setq sc 3))
  31. (if (/= l 0)(setq ll (getreal "\n┐╫ ╡─ ╕÷ ╩²=: ")))
  32. ;(if (and (/= l 0) (/= sc 2))(setq lk (getreal "\n┐╫ ╙δ ╓╨ ╨─ ╝╨ ╜╟=: ")))
  33. (COND ((and (/= l 0) (/= sc 2))
  34.   (setq lk (getreal "\n┐╫╙δ╓╨╨─╝╨╜╟(0): "))
  35.   (COND ((= LK NIL)(SETQ LK 0)))
  36. ))
  37. )
  38. ;**************************************
  39. ;*  The program for drawing centerline.*
  40. ;***************************************
  41. (DEFUN CENLINE ()
  42. ;(SETVAR "CMDECHO" 0)
  43. (command "layer" "n" "f6" "s" "f6" "l" "dashdot" "" "color" "1" "" "")
  44. (cenline1)
  45. (command "line" tof toe "")
  46. (command "layer" "n" "f8" "s" "f8" "l" "hidden" "" "color" "4" "" "")
  47. ;(redraw)
  48. ;(MENUCMD "I=DD")
  49. ;(MENUCMD "I=*")
  50. )
  51. ;*****************************************
  52. ;*  The program for drawing hole.        *
  53. ;*****************************************
  54. (DEFUN LKK ()
  55. (SETVAR "CMDECHO" 0)
  56. (SETVAR "BLIPMODE" 0)
  57. (CENLINE)
  58. (MENUCMD "S=IN1")
  59. (setq dr (getreal "\n╩Σ╚δ┬▌┐╫╡─╓▒╛╢: "))
  60. ;(setq dgch "  ")
  61. ;(MENUCMD "S=IN2")
  62. ;(setq yn (getstring "\n╙╨ ┼Σ ║╧ ╛½ ╢╚ ╖±(N)? "))
  63. ;(if (or (= yn "y") (= yn "Y"))
  64. ; (PROGN
  65. ; (MENUCMD "S=CY1")
  66. ; (setq dgch (getstring "\n╩Σ ╚δ ┼Σ ║╧ ╛½ ╢╚: "))
  67. ;))
  68. (MENUCMD "S=IN1")
  69. (SETQ Z (GETSTRING "\n╟δ╩Σ╚δ┬▌┐╫╡─│ñ╢╚(═¿┐╫): "))
  70. (cond ((= z "")(setq z "T")))
  71. (if (/= z "T")(setq h (atoi z)))
  72. (setq kd 0 dgl 0 dgr 0 angl 0 angr 0)
  73. (if (or (= z "t") (= z "T"))(setq kd sc))
  74. (if (= kd 1)(setq h (- xe xg)))
  75. (if (= kd 2)(setq h (- yf ye)))
  76. (if (= kd 4)(setq h (- xg xe)))
  77. (if (= kd 5)(setq h (- ye yf)))
  78. (if (or (= kd 1) (= kd 2) (= kd 4) (= kd 5))(setq h (/ h s)))
  79. (MENUCMD "S=GK1")
  80. (setq lr (getint "\n╤í ╘±(0:╬▐╡╣╜╟ 1:╥╗├µ╡╣╜╟ 2:╦½├µ╡╣╜╟): "))
  81. (MENUCMD "S=IN1")
  82. (if (or (= lr 1) (= lr 2))(progn
  83.            (setq dgl (getreal "\n╡╣ ╜╟ │ñ ╢╚=: "))
  84.            (if (/= dgl 0)(setq angl (getreal "\n╡╣ ╜╟ ╜╟ ╢╚=: ")))
  85.            )
  86. )
  87. (if (= lr 2)(progn
  88.            (setq dgr (getreal "\n╡╣ ╜╟ │ñ ╢╚=: "))
  89.            (if (/= dgr 0)(setq angr (getreal "\n╡╣ ╜╟ ╜╟ ╢╚=: ")))
  90.            )
  91. )
  92. (setq dr1 dr dl1 dr l1 h dgl1 dgl dgr1 dgr)
  93. (setq dr (* (/ dr 2) s) h (* h s) dgl (* dgl s) dgr (* dgr s))
  94. (setq m1 0 dl dr)
  95. (if (or (= sc 1) (= sc 4))(setq m1 1))
  96. (if (or (= sc 2) (= sc 5))(setq m1 2))
  97. (setq tg (/ (sin (* (/ 3.14 180) angl)) (cos (* (/ 3.14 180) angl))))
  98. (setq atl (* tg dgl))
  99. (setq tg (/ (sin (* (/ 3.14 180) angr)) (cos (* (/ 3.14 180) angr))))
  100. (setq atr (* tg dgr))
  101. (setq topl (list 0 0) botl (list 0 0) tof (list 0 0) bof (list 0 0))
  102. (setq botr (list 0 0) toe (list 0 0) boe (list 0 0))
  103. (if (or (= sc 4) (= sc 5))(setq h (- 0 h) dgl (- 0 dgl) dgr (- 0 dgr)))
  104. (if (= m1 1)(progn
  105.             (setq topl (list xg (+ yb l dl atl)))
  106.             (setq botl (list xg (- (+ yb l) dl atl)))
  107.             (setq tof (list (+ xg dgl) (+ yb l dl)))
  108.             (setq bof (list (+ xg dgl) (- (+ yb l) dl)))
  109.             (setq toe (list (- (+ xg h) dgr) (+ yb l dr)))
  110.             (setq boe (list (- (+ xg h) dgr) (- (+ yb l) dr)))
  111.             (setq topr (list (+ xg h) (+ yb l dr atr)))
  112.             (setq botr (list (+ xg h) (- (+ yb l) dr atr)))
  113. ))
  114. (if (= m1 2)(progn
  115.             (setq topl (list (+ x1 l dl atl) yf))
  116.             (setq botl (list (- (+ x1 l) dl atl) yf))
  117.             (setq tof (list (+ x1 l dl) (- yf dgl)))
  118.             (setq bof (list (- (+ x1 l) dl) (- yf dgl)))
  119.             (setq toe (list (+ x1 l dr) (+ (- yf h) dgr)))
  120.             (setq boe (list (- (+ x1 l) dr) (+ (- yf h) dgr)))
  121.             (setq topr (list (+ x1 l dr atr) (- yf h)))
  122.             (setq botr (list (- (+ x1 l) dr atr) (- yf h)))
  123. ))
  124. (command "line" botl topl tof bof botl bof boe botr topr toe boe toe tof "")
  125. (if (= m1 1)(progn
  126.             (setq tof (list xg (+ yb l dl s)))
  127.             (setq toe (list (+ xg h) (+ yb l dl s)))
  128.             (setq bof (list xg (- (+ yb l) dl s)))
  129.             (setq boe (list (+ xg h) (- (+ yb l) dl s)))
  130. ))
  131. (if (= m1 2)(progn
  132.             (setq tof (list (+ x1 l dl s) yf))
  133.             (setq bof (list (- (+ x1 l) dl s) yf))
  134.             (setq toe (list (+ x1 l dl s) (- yf h)))
  135.             (setq boe (list (- (+ x1 l) dl s) (- yf h)))
  136. ))
  137. (command "line" tof toe "")
  138. (command "line" bof boe "")
  139. (command "layer" "s" "" "l" "hidden" "" "")
  140. (setq topr (list 0 0) dgr 0.001)
  141. (if (= sc 3)(setq dgr dr topr (list (+ x1 l) yb)))
  142. (command "circle" topr dgr)
  143. (if (or (= sc 4) (= sc 1))(setq lx (- xg xf) ly l))
  144. (if (or (= sc 5) (= sc 2))(setq lx (+ (- x1 xf) l) ly (- yf yb)))
  145. (if (= sc 3)(setq lx l ly 0))
  146. (setq lx (/ lx s) ly (/ ly s) no (+ no 1) schl lx xchl ly)
  147. (if (= sc 1)(setq fpt (list xg (+ yb l))))
  148. (if (= sc 2)(setq fpt boe))
  149. (if (= sc 3)(setq fpt topr))
  150. (if (= sc 4)(setq fpt boe))
  151. (if (= sc 5)(setq fpt botl))
  152. (attdef2)
  153. (attdef1 "ll1" ll fpt)
  154. (attdef1 "lk1" lk fpt)
  155. (attdef1 "gpsz1" "LK" fpt)
  156. (attdef1 "nk1" sc fpt)
  157. ;(attdef1 "dgch1" dgch fpt)
  158. (if (= sc 3)(setq botl (list (- (+ x1 l) dr) (- yb dr))))
  159. (if (= sc 3)(setq toe (list (+ x1 l dr) (+ yb dr))))
  160. (command "block" no fpt "w" bof toe "")
  161. (command "insert" no fpt "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "")
  162. (if (or (= sc 1) (= sc 4))(setq xg (+ xg h)))
  163. (if (or (= sc 2) (= sc 5))(setq yf (- yf h)))
  164. ;(redraw)
  165. (MENUCMD "S=SCREEN")
  166. (MENUCMD "S=IN2")
  167. (SETQ YN (GETSTRING "\n╩╟╖±╝╠╨°╗¡┐╫: "))
  168. (IF (OR (= YN "Y") (= YN "y"))
  169.  (PROGN(MENUCMD "I=DD")
  170.        (MENUCMD "I=*")
  171.  )
  172.  (MENUCMD "S=SCREEN")
  173. )
  174. )
  175. (LKK)
  176.