home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 3.ddi / LPM / GQ1.LSP next >
Encoding:
Text File  |  1991-09-18  |  2.0 KB  |  67 lines
  1. (DEFUN C:GQ1( );1989-10-15
  2.     (IF (NOT (EQUAL (GETVAR "CLAYER") "LQC"))
  3.         (COMMAND "LAYER" "M" "LQC" ""))
  4.     (INITGET 1)
  5. (SETQ A (GETPOINT "Please input firse point:"))
  6.     (TERPRI)
  7.     (INITGET 1)
  8. (SETQ B (GETPOINT A "please input second point:"))
  9.     (TERPRI)
  10.     (INITGET 6)
  11. (SETQ D1 (GETREAL "Please input D1<120>:"))
  12. (IF (= D1 nil) (SETQ D1 120))
  13.     (INITGET 6)
  14. (SETQ D2 (GETREAL "please input D2<120>:"))
  15. (IF (= D2 nil) (SETQ D2 120))
  16. (SETQ F (OPEN "JD.DAT" "r"))
  17. (SETQ aaaa (READ-LINE f))
  18. (SETQ tb (read (read-line f)))
  19. (SETQ wth (read (read-line f)))
  20. (close f)
  21. (if (= wth nil) (setq wth 50))
  22. (setq d1 (- d1 (* wth 0.5)))
  23. (setq d2 (- d2 (* wth 0.5)))
  24. (setq fab (angle a b))
  25. (setq fa1 (- fab 1.57079633))
  26. (setq dx (* d1 (cos fa1)))
  27. (setq dy (* d1 (sin fa1)))
  28. (setq a1 (list (+ (car a) dx) (+ (cadr a) dy)))
  29. (setq b1 (list (+ (car b) dx) (+ (cadr b) dy)))
  30. (setq fa1 (+ fab 1.57079633))
  31. (setq dx (* d2 (cos fa1)))
  32. (setq dy (* d2 (sin fa1)))
  33. (setq a2 (list (+ (car a) dx) (+ (cadr a) dy)))
  34. (setq b2 (list (+ (car b) dx) (+ (cadr b) dy)))
  35. (COMMAND "TRACE" WTH A1 B1 "")
  36. (COMMAND "TRACE" WTH B2 A2 "")
  37. )
  38. (DEFUN C:GQ2( );1989-10-15
  39.     (IF (NOT (EQUAL (GETVAR "CLAYER") "LQC"))
  40.         (COMMAND "LAYER" "M" "LQC" ""))
  41.     (INITGET 1)
  42. (SETQ A (GETPOINT "Please input firse point:"))
  43.     (TERPRI)
  44.     (INITGET 1)
  45. (SETQ B (GETPOINT A "please input second point:"))
  46.     (TERPRI)
  47.     (INITGET 6)
  48. (SETQ D1 (GETREAL "Please input D1<120>:"))
  49. (IF (= D1 nil) (SETQ D1 120))
  50.     (INITGET 6)
  51. (SETQ D2 (GETREAL "please input D2<120>:"))
  52. (IF (= D2 nil) (SETQ D2 120))
  53. (SETQ FAB (ANGLE A B))
  54. (SETQ FA1 (- FAB 1.57079633))
  55. (SETQ DX (* D1 (COS FA1)))
  56. (SETQ DY (* D1 (SIN FA1)))
  57. (SETQ A1 (LIST (+ (CAR A) DX) (+ (CADR A) DY)))
  58. (SETQ B1 (LIST (+ (CAR B) DX) (+ (CADR B) DY)))
  59. (SETQ FA1 (+ FAB 1.57079633))
  60. (SETQ DX (* D2 (COS FA1)))
  61. (SETQ DY (* D2 (SIN FA1)))
  62. (SETQ A2 (LIST (+ (CAR A) DX) (+ (CADR A) DY)))
  63. (SETQ B2 (LIST (+ (CAR B) DX) (+ (CADR B) DY)))
  64. (COMMAND "LINE" A1 B1 "")
  65. (COMMAND "LINE" B2 A2 "")
  66. )
  67.