home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / KUN.LSP < prev    next >
Encoding:
Text File  |  1990-03-23  |  3.5 KB  |  78 lines
  1. ;*****************************************
  2. ;* The program for drawing side undercut.*
  3. ;*****************************************
  4. (DEFUN KUN ()
  5. (setvar "cmdecho" 0)
  6. (MENUCMD "S=IN1")
  7. (setq fpt1 (getpoint "\n╙├ ╩« ╫╓ ╧▀ ╢¿ │÷ ╢╦ ├µ ┐╒ ╡╢ ▓█ :"))
  8. (setq xc (car fpt1) yc (cadr fpt1))
  9. (setq fpt (getpoint "\n╩Σ ╚δ ╥² │÷ ╡π :"))
  10. (setq kn (getint "\n╤í ╘± ╖┼ ┤≤ ═╝ ├√(1; 2; 3; 4): "))
  11. (setq xf (car fpt) yf (cadr fpt))
  12. (if (>= xf xc)(setq xe (+ xf 12))(setq xe (- xf 12)))
  13. (command "circle" fpt1 4)
  14. (setq a (angle fpt1 fpt))
  15. (setq a (angtos a 0 4))
  16. (setq a (atof a))
  17. (setq xg (+ xc (* 4 (cos (/ (* a 3.1415) 180.)))))
  18. (setq yg (+ yc (* 4 (sin (/ (* a 3.1415) 180.)))))
  19. (command "line" (list xg yg) (list xf yf) (list xe yf) "")
  20. (if (< xf xc)(setq fpt (list (+ xe 4) (+ yf 2)))(setq fpt (list (- xe 8) (+ yf 2))))
  21. (setq knn (nth kn '(nil "gbz/nkk" "gbz/nkk1" "gbz/nkk2" "gbz/nkk3")))
  22. (command "insert" knn fpt "" "" "0")
  23. (setq fpt (getpoint "\n╙├ ╩« ╫╓ ╧▀ ╢¿ ╓├ ╖┼ ┤≤ ═╝ ╬╗ ╓├:"))
  24. (setq a (getstring "\n╩Σ ╚δ ┐╒ ╡╢ ▓█ ▓█ ┐φ(2;3;4;5)=: "))
  25. (if (or (= a "2") (= a "3"))(setq sc 5)(setq sc 2))
  26. (setq b (getstring "\n╩Σ ╚δ ┐╒ ╡╢ ▓█ ▓█ ╔ε(0.5;1)=: "))
  27. (setq xg (car fpt) yg (cadr fpt) hh (* 0.75 sc))
  28. (if (and (> yf yc) (<= xe xf))(progn
  29. ; (setq kunl (strcat "*C:" "kunl"))
  30. (command "insert" "/housem/gbz/kunl" fpt sc sc "")
  31. (command "text" (list (+ xg (* sc 1.75)) (+ yg (* sc 5.5))) hh "0" a)
  32. (command "text" (list (+ xg (* sc 5.7)) (+ yg (* sc 5.5))) hh "0" b)
  33. (command "text" (list (- xg (* sc 5.7)) (- yg (* sc 2.3))) hh "90" a)
  34. (command "text" "c" (list (- xg (* sc 5.7)) (- yg (* sc 6.7))) hh "90" b)
  35. ))
  36. (if (and (> yf yc) (>= xe xf))(progn
  37. ;(setq kunr (strcat "*C:" "kunr"))
  38. (command "insert" "/housem/gbz/kunr" fpt sc sc "")
  39. (command "text" (list (- xg (* sc 2)) (+ yg (* sc 5.5))) hh "0" a)
  40. (command "text" "c" (list (- xg (* sc 6)) (+ yg (* sc 5.5))) hh "0" b)
  41. (command "text" (list (+ xg (* sc 6.2)) (- yg (* sc 2.5))) hh "90" a)
  42. (command "text" "c" (list (+ xg (* sc 6.2)) (- yg (* sc 6.5))) hh "90" b)
  43. ))
  44. (if (and (< yf yc) (<= xe xf))(progn
  45. (setq kunl-x (strcat "*C:" "kunl-x"))
  46. (command "insert" "/housem/gbz/kunl-x" fpt sc sc "")
  47. (command "text" (list (- xg (* sc 4.7)) (+ yg (* sc 1.5))) hh "90" a)
  48. (command "text" (list (- xg (* sc 4.7)) (+ yg (* sc 4.7))) hh "90" b)
  49. (command "text" (list (+ xg (* sc 1.5)) (- yg (* sc 5))) hh "0" a)
  50. (command "text" (list (+ xg (* sc 4.7)) (- yg (* sc 5))) hh "0" b)
  51. ))
  52. (if (and (< yf yc) (>= xe xf))(progn
  53. ;(setq kunr-x (strcat "*C:" "kunr-x"))
  54. (command "insert" "/housem/gbz/kunr-x" fpt sc sc "")
  55. (command "text" (list (- xg (* sc 2)) (- yg (* sc 5))) hh "0" a)
  56. (command "text" "c" (list (- xg (* sc 5.4)) (- yg (* sc 5))) hh "0" b)
  57. (command "text" (list (+ xg (* sc 5.1)) (+ yg (* sc 1.4))) hh "90" a)
  58. (command "text" (list (+ xg (* sc 5.1)) (+ yg (* sc 4.6))) hh "90" b)
  59. ))
  60. (setq sc (itoa sc))
  61. (setq ab (strcat sc " : 1"))
  62. (setq sc (atoi sc))
  63. (if (< sc 4)(setq sc 3.5)(setq sc 4))
  64. (if  (> yf yc) (progn
  65. (command "line" (list (- xg 9.5) (+ yg (* sc 12.7))) (list (+ xg 7.2) (+ yg (* sc 12.7))) "")
  66. (command "insert" knn (list (- xg 3.5) (+ yg (* sc 13))) "" "" "0")
  67. (command "text" (list (- xg 8.0) (+ yg (* sc 11))) "4" "0" ab)
  68. ))
  69. (if (< yf yc) (progn
  70. (command "line" (list (- xg 8.5) (+ yg (* sc 10.2))) (list (+ xg 8.2) (+ yg (* sc 10.2))) "")
  71. (command "insert" knn (list (- xg 3.0) (+ yg (* sc 10.5))) "" "" "0")
  72. (command "text" (list (- xg 7.0) (+ yg (* sc 8.8))) "4" "0" ab)
  73. ))
  74. (redraw)
  75. (MENUCMD "S=SCREEN")
  76. )
  77. (KUN)
  78.