home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / HM06.LSP < prev    next >
Encoding:
Text File  |  1991-04-08  |  3.4 KB  |  102 lines
  1. ;**********************************
  2. ;*   The program for drawing gear.*
  3. ;**********************************
  4. (DEFUN GEAR ()
  5. (SETVAR "CMDECHO" 0)
  6. (SETVAR "BLIPMODE" 0)
  7. (MENUCMD "S=GE1")
  8.  (initget (+ 1 2 4))
  9. (setq m1 (getreal "\n╟δ╩Σ╚δ│▌┬╓╡──ú╩²: "))
  10. (MENUCMD "S=IN1")
  11.  (initget (+ 1 2 4))
  12. (setq z (getreal "\n╟δ╩Σ╚δ│▌╩²: "))
  13.   (setq alf (getreal "\n╟δ╩Σ╚δ╤╣┴ª╜╟(20): "))
  14.   (if (null alf)(setq alf 20))
  15.  (initget (+ 1 2 4))
  16.   (setq l (getreal "\n╟δ╩Σ╚δ│▌┬╓╡─┐φ╢╚: "))
  17. (MENUCMD "S=IN2")
  18.   (setq yn (getstring "\n╙╨ ╣½ ▓ε ╖±(N)? "))
  19. (MENUCMD "S=IN1")
  20.   (if (null yn)(setq yn "n" schl 0 xchl 0))
  21.   (if (or (= yn "y") (= yn "Y"))(progn
  22.                                  (setq schl (getreal "\n╔╧ ╞½ ▓ε=: "))
  23.                                  (setq xchl (getreal "\n╧┬ ╞½ ▓ε=: "))
  24.                                  )
  25.   )
  26.   (setq angl 0 angr 0 dgl 0 dgr 0)
  27.    (setq angl (getreal "\n╟δ╩Σ╚δ╫≤╡╣╜╟(12): "))
  28.   (if (null angl)(progn
  29.                  (setq angl 12)
  30.                  (setq dgl (* 0.45 m1))
  31.   ))
  32.   (if (and (/= angl 0) (/= angl 12))(progn
  33.   (setq dgl (getreal "\n╫≤ ╡╣ ╜╟ │ñ ╢╚(0): "))
  34.   (if (null dgl)(setq dgl 0))
  35. ))
  36.   (setq angr (getreal "\n╟δ╩Σ╚δ╙╥╡╣╜╟(12): "))
  37.   (if (null angr)(progn
  38.                  (setq angr 12)
  39.                  (setq dgr (* 0.45 m1))
  40.   ))
  41.   (if (and (/= angr 0) (/= angr 12))(progn
  42.   (setq dgr (getreal "\n╟δ╩Σ╚δ╙╥╡╣╜╟╡─│ñ╢╚(0): "))
  43.   (if (null dgr)(setq dgr 0))
  44. ))
  45. (MENUCMD "S=IN2")
  46. (setq sc (getstring "\n┬▌ ╨² │▌ ┬╓ ╖±(N)? "))
  47. (MENUCMD "S=IN1")
  48. (if (null sc)(setq sc "n"))
  49. (if (or (/= sc "y") (/= sc "Y"))(setq bat 0))
  50. (if (or (= sc "y") (= sc "Y"))(setq bat (getreal "\n╩Σ ╚δ ┬▌ ╨² ╜╟=: ")))
  51. (MENUCMD "S=IN2")
  52. (if (/= bat 0)(setq yn (getstring "\n╫≤ ╨²(L) ╗≥ ╙╥ ╨²(R)? ")))
  53. (if (null yn)(setq yn "R"))
  54. (if (= yn " ")(setq yn "R"))
  55. (setq dr (* (+ z 2) m1) dr1 dr dl1 dr l1 l kd (* m1 z))
  56. (setq dgl1 dgl dgr1 dgr dgl (* dgl s) dgr (* dgr s))
  57. (setq dr (* (/ dr 2) s) dl dr l (* l s) kd (* (/ kd  2) s))
  58. (dbsa1 xb 0)
  59. (setq tof (list xb (+ yb kd)) toe (list (+ xb l) (+ yb kd)))
  60. (setq bof (list xb (- yb kd)) boe (list (+ xb l) (- yb kd)))
  61. (command "layer" "n" "f7" "s" "f7" "l" "dashdot" "" "")
  62. (command "line" tof toe "")
  63. (command "line" bof boe "")
  64. (command "layer" "s" 0 "l" "" "" "")
  65. (setq t (/ (sin (* (/ 3.14 180) bat)) (cos (* (/ 3.14 180) bat))))
  66. (setq atr (* t (/ l 2)))
  67. (setq tof (list 0 0) bof tof boe tof bof tof toe tof)
  68. (if (= yn "L")(setq atr (- 0 atr)))
  69. (if (/= bat 0)(setq tof (list (+ xb dgl) (+ yb atr))))
  70. (if (/= bat 0)(setq toe (list (- (+ xb l) dgr) (- yb atr))))
  71. (if (/= bat 0)(setq bof (list (+ xb dgl) (+ yb atr 0.1))))
  72. (if (/= bat 0)(setq boe (list (- (+ xb l) dgr) (+ (- yb atr) 0.1))))
  73. (command "line" tof toe "")
  74. (command "line" bof boe "")
  75. (FN)
  76. (NZ1)
  77. (attdef2)
  78. (attdef1 "nzl1" nzl fpt)
  79. (attdef1 "gpsz1" "Z" fpt)
  80. (attdef1 "m1" m1 fpt)
  81. (attdef1 "bf1" bat fpt)
  82. (attdef1 "alf1" alf fpt)
  83. (attdef1 "z11" z fpt)
  84. (attdef1 "dir1" yn fpt)
  85.  (if (= nol no)
  86. (command "block" no "Y" fpt "w" (list xb (- yb dr)) (list (+ xb l) (+ yb dr)) "")
  87. (command "block" no fpt "w" (list xb (- yb dr)) (list (+ xb l) (+ yb dr)) "")
  88.  )
  89. (command "insert" no fpt "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "")
  90. (XB1)
  91. (MENUCMD "S=SCREEN")
  92. (MENUCMD "S=IN2")
  93. (SETQ YN (GETSTRING "\n╩╟╖±╝╠╨°╗¡═Γ▒φ├µ: "))
  94. (IF (OR (= YN "Y") (= YN "y") (= YN ""))
  95.  (PROGN(MENUCMD "I=YY")
  96.        (MENUCMD "I=*")
  97.  )
  98.                (MENUCMD "S=SCREEN")
  99. )
  100. )
  101. (GEAR)
  102.