home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / HM10.LSP < prev    next >
Encoding:
Text File  |  1990-03-09  |  3.8 KB  |  110 lines
  1. ;**************************************
  2. ;*  The fuction for drwing worm wheel*
  3. ;*************************************
  4. (defun WWHEEL ()
  5. (SETVAR "CMDECHO" 0)
  6. (SETVAR "BLIPMODE" 0)
  7. (SETQ DGCH "")
  8. (MENUCMD "S=WB1")
  9. (SETQ M (GETREAL "\n╟δ╩Σ╚δ╬╧┬╓╡──ú╩²: "))
  10. (MENUCMD "S=IN1")
  11. (SETQ Q (GETREAL "\n╟δ╩Σ╚δ╬╧╕╦╡─╠╪╨╘╧╡╩²: "))
  12. (SETQ Z1 (GETREAL "\n╟δ╩Σ╚δ╬╧╕╦╡─═╖╩²: "))
  13. (SETQ Z2 (GETREAL "\n╟δ╩Σ╚δ╬╧┬╓╡─│▌╩²: "))
  14. (MENUCMD "S=IN2")
  15. (SETQ YY (GETSTRING "\n╟δ╩Σ╚δ┬▌╨²╖╜╧≥(R): "))
  16. (COND ((= YY "")(SETQ YY "R")))
  17. (MENUCMD "S=IN1")
  18. (SETQ ALF (GETREAL "\n╟δ╩Σ╚δ╬╧┬╓╡─╤╣┴ª╜╟(20): "))
  19. (COND ((= ALF NIL)(SETQ ALF 20)))
  20. (SETQ DF1 (* M Q))
  21. (SETQ DF2 (* M Z2))
  22. (SETQ DE2 (* M (+ Z2 2)))
  23. (SETQ DI2 (* M (- Z2 2.4)))
  24. (SETQ R1 (- (/ DF1 2) M))
  25. (SETQ R2 (+ (/ DF1 2) (* 1.2 M)))
  26. (SETQ LMIN (* 2 (SQRT (- (* (/ DF1 2) (/ DF1 2)) (* R1 R1)))))
  27. ;(SETQ LMIN (* 2 (* (/ DF1 2) (SIN (/ (* 22.5 PI) 180)))))
  28. (GRTEXT -1 (STRCAT (RTOS LMIN 2 2) " <╬╧┬╓╡─│▌┐φ<= " (RTOS DF1 2 2)))
  29. (SETQ L1 (GETREAL "\n╟δ╩Σ╚δ╬╧┬╓╡─│▌┐φ: "))
  30. (GRTEXT -1 (STRCAT "╖°░σ╡─┐φ╢╚< " (RTOS L1 2 2)))
  31. (SETQ L2 (GETREAL "\n╟δ╩Σ╚δ╖°░σ╡─┐φ╢╚: "))
  32. (SETQ K (GETREAL "\n╟δ╩Σ╚δ│▌╕∙╡─║±╢╚: "))
  33. (SETQ D1 (* 2 (- (/ (+ DF1 DF2) 2) (+ R2 K))))
  34. (GRTEXT -1 (STRCAT "┬╓╘╡╡─╓▒╛╢< " (RTOS D1 2 2)))
  35. (SETQ D1 (GETREAL "\n╟δ╩Σ╚δ┬╓╘╡╓▒╛╢: "))
  36. (GRTEXT)
  37. (SETQ L (GETREAL "\n╟δ╩Σ╚δ┬╓╘╡╡─┐φ╢╚: "))
  38. (INITGET "Y N")
  39. (SETQ DGL1 (GETREAL "\n╟δ╩Σ╚δ┬╓╘╡╡╣╜╟│ñ╢╚(0): "))
  40. (COND ((= DGL1 NIL)(SETQ DGL1 0 ANGL 0)))
  41. (COND ((/= DGL1 0)(SETQ ANGL (GETREAL "\n╟δ╩Σ╚δ┬╓╘╡╡╣╜╟: "))))
  42. (SETQ DGL1 (* DGL1 S))
  43. (SETQ DF1 (* DF1 S) DF2 (* DF2 S) DE2 (* DE2 S))
  44. (SETQ DI2 (* DI2 S) R1 (* R1 S) R2 (* R2 S))
  45. (SETQ L1 (* L1 S) D1 (* D1 S) L (* L S) L2 (* L2 S) K (* K S))
  46. (SETQ P1 (LIST XB (+ YB (/ D1 2))))
  47. (SETQ P2 (LIST (+ XB (/ (- L L1) 2)) (CADR P1)))
  48. (SETQ PO (LIST (+ XB (/ L 2)) (+ YB (/ (+ DF1 DF2) 2))))
  49. (SETQ P3 (LIST (- (CAR PO) (/ L2 2)) (CADR P2)))
  50. (SETQ RK (+ R2 K))
  51. (SETQ X4 (/ L2 2))
  52. (SETQ Y4 (SQRT (- (* RK RK) (* X4 X4))))
  53. (SETQ P4 (LIST (CAR P3) (- (CADR PO) Y4)))
  54. (SETQ X5 (/ L1 2))
  55. (SETQ Y5 (SQRT (- (* RK RK) (* X5 X5))))
  56. (SETQ P5 (LIST (CAR P2) (- (CADR PO) Y5)))
  57. (SETQ Y6 (SQRT (- (* R2 R2) (* X5 X5))))
  58. (SETQ P6 (LIST (CAR P2) (- (CADR PO) Y6)))
  59. (SETQ R3 (/ DF1 2))
  60. (SETQ Y7 (SQRT (- (* R3 R3) (* X5 X5))))
  61. (SETQ P7 (LIST (CAR P2) (- (CADR PO) Y7)))
  62. (SETQ X8 (SQRT (- (* R1 R1) (* Y7 Y7))))
  63. (SETQ P8 (LIST (- (CAR PO) X8) (- (CADR PO) Y7)))
  64. (SETQ P9 (LIST (CAR PO) (- (CADR PO) R1)))
  65. (SETQ P10 (LIST (CAR PO) (- (CADR PO) (/ DF1 2))))
  66. (SETQ P11 (LIST (CAR PO) (- (CADR PO) R2)))
  67. (SETQ B (LIST XB YB))
  68. (COMMAND "LINE" B P1 P2 P6 P7 P8 "")
  69. (COMMAND "ARC" P8 "C" PO P9 )
  70. (COMMAND "ARC" P6 "C" PO P11 )
  71. (COMMAND "LAYER" "N" "F2" "S" "F2" "L" "HIDDEN" "" "C" "G" "" "")
  72. (COMMAND "LINE" P2 P3 P4 "")
  73. (COMMAND "ARC" P5 "C" PO P4 )
  74. (COMMAND "LAYER" "N" "F7" "S" "F7" "L" "DASHDOT" "" "C" "Y" "" "")
  75. (COMMAND "ARC" P7 "C" PO P10 )
  76. (COMMAND "MIRROR" "W" B PO "" PO P11 "N")
  77. (SETQ PO1 (LIST (+ (CAR B) L) (CADR PO)))
  78. (SETQ PO2 (LIST (CAR PO) (CADR B)))
  79. (COMMAND "MIRROR" "W" B PO1 "" B PO2 "N")
  80. (COMMAND "LAYER" "S" 0 "L" "" "" "")
  81. (FN)
  82. (SETQ DL1 D1 DR1 D1 SCHL Z1 XCHL L1 ANGR Q L1 L)
  83. (SETQ DGR1 L2 LK K)
  84. (SETQ DL1 (/ DL1 S) DR1 (/ DR1 S) L1 (/ L1 S))
  85. (SETQ XCHL (/ XCHL S) DGL1 (/ DGL1 S))
  86. (SETQ DGR1 (/ DGR1 S) LK (/ LK S))
  87. (attdef2)
  88. (ATTDEF1 "LK1" LK FPT)
  89. (ATTDEF1 "GPSZ1" "WW" FPT)
  90. (ATTDEF1 "M1" M FPT)
  91. (ATTDEF1 "ALF1" ALF FPT)
  92. (ATTDEF1 "Z11" Z2 FPT)
  93. (ATTDEF1 "DIR1" YY FPT)
  94. (SETQ LB (LIST (CAR B) (- 0 (CADR PO))))
  95. (SETQ RT (LIST (+ (CAR B) L) (CADR PO)))
  96. (command "block" no fpt "w" LB RT "")
  97. (command "insert" no fpt "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "")
  98. (XB1)
  99. ;(redraw)
  100. ;(MENUCMD "S=IN2")
  101. ;(SETQ YN (GETSTRING "\n╩╟╖±╝╠╨°╗¡═Γ▒φ├µ: "))
  102. ;(IF (OR (= YN "Y") (= YN "y"))
  103. ; (PROGN(MENUCMD "I=YY")
  104. ;       (MENUCMD "I=*")
  105. ; )
  106.                (MENUCMD "S=SCREEN")
  107. ;)
  108. )
  109. (WWHEEL)
  110.