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