home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / HM20.LSP < prev    next >
Encoding:
Text File  |  1991-04-10  |  5.9 KB  |  165 lines
  1. (DEFUN CENLINE1 ()
  2. (MENUCMD "S=IN2")
  3. (INITGET (+ 1 2 4) "Y N 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 GK ()
  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 (= 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. (command "layer" "s" "" "l" "hidden" "" "")
  126. (setq topr (list 0 0) dgr 0.001)
  127. (if (= sc 3)(setq dgr dr topr (list (+ x1 l) yb)))
  128. (command "circle" topr dgr)
  129. (if (or (= sc 4) (= sc 1))(setq lx (- xg xf) ly l))
  130. (if (or (= sc 5) (= sc 2))(setq lx (+ (- x1 xf) l) ly (- yf yb)))
  131. (if (= sc 3)(setq lx l ly 0))
  132. (setq lx (/ lx s) ly (/ ly s) no (+ no 1) schl lx xchl ly)
  133. (if (= sc 1)(setq fpt bof))
  134. (if (= sc 2)(setq fpt boe))
  135. (if (= sc 3)(setq fpt topr))
  136. (if (= sc 4)(setq fpt boe))
  137. (if (= sc 5)(setq fpt botl))
  138. (attdef2)
  139. (attdef1 "ll1" ll fpt)
  140. (attdef1 "lk1" lk fpt)
  141. (attdef1 "gpsz1" "GK" fpt)
  142. (attdef1 "nk1" sc fpt)
  143. (attdef1 "dgch1" dgch fpt)
  144. (if (= sc 3)(setq botl (list (- (+ x1 l) dr) (- yb dr))))
  145. (if (= sc 3)(setq toe (list (+ x1 l dr) (+ yb dr))))
  146.  (if (= nol no)
  147. (command "block" no "Y" fpt "w" botl toe "")
  148. (command "block" no fpt "w" botl toe "")
  149.  )
  150. (command "insert" no fpt "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "")
  151. (if (or (= sc 1) (= sc 4))(setq xg (+ xg h)))
  152. (if (or (= sc 2) (= sc 5))(setq yf (- yf h)))
  153. ;(redraw)
  154. (MENUCMD "S=SCREEN")
  155. (MENUCMD "S=IN2")
  156. (SETQ YN (GETSTRING "\n╩╟╖±╝╠╨°╗¡┐╫: "))
  157. (IF (OR (= YN "Y") (= YN "y") (= YN ""))
  158.  (PROGN(MENUCMD "I=DD")
  159.        (MENUCMD "I=*")
  160.  )
  161.  (MENUCMD "S=SCREEN")
  162. )
  163. )
  164. (GK)
  165.