home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / DK1.LSP < prev    next >
Encoding:
Text File  |  1987-12-25  |  2.9 KB  |  71 lines
  1. ;*****************************************
  2. ;*  The program for drawing screw hole.  *
  3. ;*****************************************
  4. (setq dr (getreal "\n╩Σ ╚δ ╓▒ ╛╢=: "))
  5. (setq dgch "  ")
  6. (setq yn (getstring "\n╙╨ ┼Σ ║╧ ╛½ ╢╚ ╖±(N)? "))
  7. (if (or (= yn "y") (= yn "Y"))(setq dgch (getstring "\n╩Σ ╚δ ┼Σ ║╧ ╛½ ╢╚: ")))
  8. (setq h (getreal "\n╩Σ ╚δ ╢ñ ┐╫ ╔ε ╢╚=: "))
  9. (setq dgl 0. dgr 0.)
  10. (setq dr1 dr dl1 dr l1 h dgl1 dgl dgr1 dgr)
  11. (setq dr (* (/ dr 2) s) h (* h s))
  12. (setq m1 0 dl dr)
  13. (if (or (= sc 1) (= sc 4))(setq m1 1))
  14. (if (or (= sc 2) (= sc 5))(setq m1 2))
  15. (if (or (= sc 1) (= sc 2))(setq kd dl))
  16. (if (= sc 4)(setq kd (- 0 dl)))
  17. (setq topl (list 0 0) botl (list 0 0) tof (list 0 0) bof (list 0 0))
  18. (setq botr (list 0 0) toe (list 0 0) boe (list 0 0))
  19. (if (or (= sc 4) (= sc 5))(setq h (- 0 h) dgl (- 0 dgl) dgr (- 0 dgr)))
  20. (if (= m1 1)(progn
  21.             (setq topl (list xg (+ yb l dl)))
  22.             (setq botl (list xg (- (+ yb l) dl)))
  23.             (setq tof (list xg (- (+ yb l dl) s)))
  24.             (setq bof (list xg (- (+ yb l s) dl)))
  25.             (setq toe (list (+ xg h kd) (- (+ yb l dl) s)))
  26.             (setq boe (list (+ xg h kd) (- (+ yb l s) dl)))
  27.             (setq topr (list (+ xg h) (+ yb l dr)))
  28.             (setq botr (list (+ xg h) (- (+ yb l) dr)))
  29.             (setq ept (list (+ xg h kd (* 0.577 kd)) (+ yb l)))
  30. ))
  31. (if (= m1 2)(progn
  32.             (setq topl (list (+ x1 l dl) yf))
  33.             (setq botl (list (- (+ x1 l) dl) yf))
  34.             (setq tof (list (- (+ x1 l dl) s) yf))
  35.             (setq bof (list (- (+ x1 l s) dl) yf))
  36.             (setq toe (list (- (+ x1 l dl) s) (- yf h kd)))
  37.             (setq boe (list (- (+ x1 l s) dl) (- yf h kd)))
  38.             (setq topr (list (+ x1 l dr) (- yf h)))
  39.             (setq botr (list (- (+ x1 l) dr) (- yf h)))
  40.             (setq ept (list (+ x1 l) (- yf h kd (* 0.577 kd))))
  41. ))
  42. (command "line" topl topr botr botl "")
  43. (command "line" tof toe ept boe toe boe bof "")
  44. (command "layer" "s" "" "l" "hidden" "" "")
  45. (setq topr (list 0 0) dgr 0.001)
  46. (if (= sc 3)(setq dgr dr topr (list (+ x1 l) yb)))
  47. (command "circle" topr dgr)
  48. (if (or (= sc 4) (= sc 1))(setq lx (- xg xf) ly l))
  49. (if (or (= sc 5) (= sc 2))(setq lx (+ (- xg xf) l) ly (- yf yb)))
  50. (if (= sc 3)(setq lx l ly 0))
  51. (setq lx (/ lx s) ly (/ ly s) no (+ no 1) schl lx xchl ly)
  52. (if (= sc 1)(setq fpt (list xg (+ yb l))))
  53. (if (= sc 2)(setq fpt (list (+ x1 l) yf)))
  54. (if (= sc 3)(setq fpt topr))
  55. (if (= sc 4)(setq fpt toe))
  56. (if (= sc 5)(setq fpt boe))
  57. (attdef2)
  58. (attdef1 "ll1" ll fpt)
  59. (attdef1 "lk1" lk fpt)
  60. (attdef1 "gpsz1" "DK" fpt)
  61. (attdef1 "nk1" sc fpt)
  62. (attdef1 "dgch1" dgch fpt)
  63. (if (= sc 3)(setq botl (list (- (+ x1 l) dr) (- yb dr))))
  64. (if (= sc 3)(setq toe (list (+ x1 l dr) (+ yb dr))))
  65. (command "block" no fpt "w" botl toe "")
  66. (command "insert" no fpt "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "")
  67. (if (or (= sc 1) (= sc 4))(setq xg (+ xg h)))
  68. (if (or (= sc 2) (= sc 5))(setq yf (- yf h)))
  69. (redraw)
  70. (quit)
  71.