home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 2.ddi / LPM / QCX.LSP < prev    next >
Encoding:
Text File  |  1991-09-05  |  2.4 KB  |  81 lines
  1. (DEFUN C:QCX();1991-9-5
  2.     (SETVAR "CMDECHO" 0)
  3.     (SETVAR "OSMODE" 0)
  4.     (IF (NOT (EQUAL (GETVAR "CLAYER") "CC1"))
  5.         (COMMAND "LAYER" "M" "CC1" ""))
  6.     (SETQ F (OPEN "/BJCAD/JD.DAT" "r"))
  7.     (SETQ TB (READ (READ-LINE F)))
  8.     (SETQ TB (READ (READ-LINE F)))
  9.     (CLOSE F)
  10.     (SETQ T1 1800)
  11.     (INITGET 1)
  12.     (SETQ C1 (GETPOINT "Input 1nd point: "))
  13.     (TERPRI)
  14.     (INITGET 1)
  15.     (SETQ C2 (GETPOINT C1 "Input 2nd point: "))
  16.     (TERPRI)
  17.     (COMMAND "LINE" C1 C2 "")
  18.     (SETVAR "ORTHOMODE" 1)
  19.     (INITGET 4)
  20.     (SETQ C3 (GETANGLE C2 "Input direction<0>: "))
  21.     (IF (= C3 nil) (SETQ C3 0))
  22.     (TERPRI)
  23.     (IF (AND (> C3 1.57) (< C3 4.7))
  24.         (SETQ C3 PI)
  25.         (SETQ C3 0)
  26.     )
  27.     (SETVAR "ORTHOMODE" 0)
  28.     (SETQ C4 (POLAR C2 C3 (* TB T1)))
  29.     (COMMAND "LINE" C2 C4 "")
  30.     (COMMAND "INSERT" "/BJCAD/J1K/SYBZ1" C4 TB TB (* C3 (/ 180 PI)))
  31.     (IF (= C3 0)
  32.         (PROGN
  33. (SETQ C (LIST (+ (CAR C2) (* T1 TB 0.5)) (- (CADR C2) (* 350 TB))))
  34. (SETQ D (LIST (+ (CAR C2) (* 400 TB)) (+ (CADR C2) (* 350 TB))))
  35. (SETQ A (LIST (+ (CAR C4) (* 500 TB)) (+ (CADR C4) (* 200 TB))))
  36. (SETQ B (LIST (+ (CAR C4) (* 500 TB)) (- (CADR C4) (* 200 TB))))
  37.         )
  38.         (PROGN
  39. (SETQ C (LIST (+ (CAR C4) (* T1 TB 0.5)) (- (CADR C4) (* 350 TB))))
  40. (SETQ D (LIST (+ (CAR C4) (* 400 TB)) (+ (CADR C4) (* 350 TB))))
  41. (SETQ A (LIST (- (CAR C4) (* 500 TB)) (+ (CADR C4) (* 200 TB))))
  42. (SETQ B (LIST (- (CAR C4) (* 500 TB)) (- (CADR C4) (* 200 TB))))
  43.         )
  44.     )
  45.     (SETQ AA (STRCAT (CHR 205) (CHR 226)))
  46.     (COMMAND "TEXT" "M" C (* 400 TB) 0 "88J1")
  47.     (COMMAND "TEXT" "M" D (* 500 TB) 0 AA)
  48.     (SETQ AA (STRCAT (CHR 199) (CHR 189)))
  49.     (SETQ D (POLAR D 0 (* TB 500)))
  50.     (COMMAND "TEXT" "M" D (* 500 TB) 0 AA)
  51.     (SETQ D (POLAR D 0 (* TB 500)))
  52.     (Z6 4 250 150 D)
  53.     (INITGET 1)
  54.     (SETQ C1 (GETSTRING "Input text (1 2 3...): "))
  55.     (COMMAND "TEXT" "M" D (* 400 TB) 0 C1)
  56.     (Z6 0 250 150 D)
  57.     (Z6 4 140 100 A)
  58.     (INITGET 1)
  59.     (SETQ C1 (GETSTRING "Input text (1 2 3...): "))
  60.     (Z6 0 140 100 A)
  61.     (COMMAND "TEXT" "M" A (* 250 TB) 0 C1)
  62.     (Z6 4 140 100 B)
  63.     (INITGET 1)
  64.     (SETQ C2 (GETSTRING "Input text (1 2 3...): "))
  65.     (Z6 0 140 100 B)
  66.     (COMMAND "TEXT" "M" B (* 250 TB) 0 C2)
  67. )
  68. (DEFUN Z6(T1 T2 T3 D)
  69.     (SETQ L1 (POLAR D 1.57079 (* TB T2)))
  70.     (SETQ L2 (POLAR L1 0 (* TB T3)))
  71.     (SETQ L1 (POLAR D -1.57079 (* TB T2)))
  72.     (SETQ L1 (POLAR L1 PI (* TB T3)))
  73.      (GRDRAW L1 (LIST (CAR L1) (CADR L2)) T1)
  74.      (GRDRAW (LIST (CAR L1) (CADR L2)) L2 T1)
  75.      (GRDRAW L2 (LIST (CAR L2) (CADR L1)) T1)
  76.      (GRDRAW (LIST (CAR L2) (CADR L1)) L1 T1)
  77. )
  78.  
  79.  
  80.  
  81.