home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / HM25.LSP < prev    next >
Encoding:
Text File  |  1990-03-12  |  4.5 KB  |  135 lines
  1. (DEFUN CENLINE1 ()
  2. (MENUCMD "S=IN2")
  3. (INITGET "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 cone hole    *
  53. ;*****************************************
  54. (DEFUN XK ()
  55. (SETVAR "CMDECHO" 0)
  56. (SETVAR "BLIPMODE" 0)
  57. (CENLINE)
  58. (setq kd 0)
  59. (setq kd sc)
  60. (if (= kd 1)(setq h (- xe xg)))
  61. (if (= kd 2)(setq h (- yf ye)))
  62. (if (= kd 4)(setq h (- xg xe)))
  63. (if (= kd 5)(setq h (- ye yf)))
  64. (if (or (= kd 1) (= kd 2) (= kd 4) (= kd 5))(setq h (/ h s)))
  65. (MENUCMD "S=IN2")
  66. (INITGET "Y N")
  67. (SETQ YN (GETSTRING "\n╩╟╘▓╓∙╧·┐╫┬≡? (Y) "))
  68. (MENUCMD "S=IN1")
  69. (setq dr (getreal "\n╩Σ ╚δ ╧· ┐╫ ╓▒ ╛╢=: "))
  70. (MENUCMD "S=IN2")
  71. (setq lr (getstring "\n┤≤ ╢╦ ╘┌ (╫≤,╔╧)(L) ╗≥ (╙╥,╧┬)(R)? "))
  72. ;(if (and (>= dr 2.5) (<= dr 4))(setq c 0.5))
  73. ;(if (and (>= dr 5) (<= 8))(setq c 1))
  74. ;(if (and (>= dr 10) (<= dr 16))(setq c 1.5))
  75. ;(if (and (>= dr 20) (<= dr 30))(setq c 3))
  76. ;(setq dl (+ dr (/ (- h (* 2 c)) 50)))
  77. (SETQ DL (+ DR (/ (* 2 H) 50)))
  78. (COND ((/= YN "N")(SETQ DL DR)))
  79. (setq kd dr)
  80. (if (or (= lr "r") (= lr "R"))(setq dr dl dl kd))
  81. (setq dr1 dr dl1 dl l1 h dgl1 0 dgr1 0)
  82. (setq dr (* (/ dr 2) s) h (* h s) dgl 0 dgr 0)
  83. (setq m1 0 dl (* (/ dl 2) s))
  84. (if (or (= sc 1) (= sc 4))(setq m1 1))
  85. (if (or (= sc 2) (= sc 5))(setq m1 2))
  86. (if (or (= sc 4) (= sc 5))(setq h (- 0 h)))
  87. (if (= m1 1)(progn
  88.             (setq tof (list xg (+ yb l dl)))
  89.             (setq bof (list xg (- (+ yb l) dl)))
  90.             (setq toe (list (+ xg h) (+ yb l dr)))
  91.             (setq boe (list (+ xg h) (- (+ yb l) dr)))
  92. ))
  93. (if (= m1 2)(progn
  94.             (setq tof (list (+ x1 l dl) yf))
  95.             (setq bof (list (- (+ x1 l) dl) yf))
  96.             (setq toe (list (+ x1 l dr) (- yf h)))
  97.             (setq boe (list (- (+ x1 l) dr) (- yf h)))
  98. ))
  99. (command "line" tof bof boe toe tof "")
  100. (command "layer" "s" "" "l" "hidden" "" "")
  101. (if (or (= sc 4) (= sc 1))(setq lx (- xg xf) ly l))
  102. (if (or (= sc 5) (= sc 2))(setq lx (+ (- x1 xf) l) ly (- yf yb)))
  103. (setq lx (/ lx s) ly (/ ly s) no (+ no 1) schl lx xchl ly)
  104. (if (= sc 1)(setq fpt bof))
  105. (if (= sc 2)(setq fpt boe))
  106. (if (= sc 4)(setq fpt boe))
  107. (if (= sc 5)(setq fpt bof))
  108. (attdef2)
  109. (attdef1 "ll1" ll fpt)
  110. (attdef1 "lk1" lk fpt)
  111. (attdef1 "gpsz1" "ZK" fpt)
  112. (attdef1 "nk1" sc fpt)
  113. (setq kd (max dl dr) no (+ no 1))
  114. (if (= m1 1)(progn
  115.             (setq botl (list xg (- (+ yb l) kd)))
  116.             (setq toe (list (+ xg h) (+ yb l kd)))
  117. ))
  118. (if (= m1 2)(progn
  119.             (setq botl (list (- (+ x1 l) kd) yf))
  120.             (setq toe (list (+ x1 l kd) (- yf h)))
  121. ))
  122. (command "block" no fpt "w" botl toe "")
  123. (command "insert" no fpt "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "")
  124. ;(redraw)
  125. (MENUCMD "S=IN2")
  126. (SETQ YN (GETSTRING "\n╩╟╖±╝╠╨°╗¡┐╫: "))
  127. (IF (OR (= YN "Y") (= YN "y"))
  128.  (PROGN(MENUCMD "I=DD")
  129.        (MENUCMD "I=*")
  130.  )
  131.  (MENUCMD "S=SCREEN")
  132. )
  133. )
  134. (XK)
  135.