home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 2.ddi / LPM / QPC.LSP < prev   
Encoding:
Text File  |  1991-09-20  |  4.8 KB  |  184 lines
  1. (DEFUN C:QPC();1991-8-12
  2.     (SETVAR "CMDECHO" 0)
  3.     (SETVAR "OSMODE" 32)
  4. ;    (SETVAR "ORTHOMODE" 1)
  5.     (INITGET 1)
  6.     (SETQ A (GETPOINT "Input bas-point:" ))
  7.     (TERPRI)
  8.     (SETVAR "OSMODE" 0)
  9.     (TERPRI)
  10.     (INITGET 6)
  11.     (SETQ E (GETdist A "Input starting distance<900>: "))
  12.     (IF (= E nil) (SETQ E 900))
  13.     (TERPRI)
  14.     (SETQ FAB 1.5707963)
  15.     (INITGET 6)
  16.     (SETQ BL (GETDIST (POLAR A FAB E) "Input win-height<1500>: "))
  17.     (IF (= BL nil) (SETQ BL 1500))
  18.     (TERPRI)
  19.     (SETQ F (OPEN "JD.DAT" "r"))
  20.     (SETQ WTH (READ (READ-LINE F)))
  21.     (SETQ WTH (READ (READ-LINE F)))
  22.     (SETQ WTH (READ (READ-LINE F)))
  23.     (CLOSE F)
  24.     (QPMC1-1)
  25. )
  26. (DEFUN C:QPC1();1991-9-19
  27.     (SETVAR "CMDECHO" 0)
  28.     (SETVAR "OSMODE" 32)
  29. ;    (SETVAR "ORTHOMODE" 1)
  30.     (INITGET 1)
  31.     (SETQ A (GETPOINT "Input bas-point:" ))
  32.     (TERPRI)
  33.     (SETVAR "OSMODE" 0)
  34.     (INITGET 6)
  35.     (SETQ E (GETdist A "Input starting distance<900>: "))
  36.     (IF (= E nil) (SETQ E 900))
  37.     (TERPRI)
  38.     (SETQ FAB 1.5707963)
  39.     (INITGET 6)
  40.     (SETQ BL (GETDIST (POLAR A FAB E) "Input win-height<1500>: "))
  41.     (IF (= BL nil) (SETQ BL 1500))
  42.     (TERPRI)
  43.     (INITGET 6)
  44.     (SETQ B (GETPOINT A "Input next point: "))
  45.     (TERPRI)
  46.     (INITGET 6)
  47.     (SETQ NN (GETINT "Input window/door number <2>: "))
  48.     (IF (= NN nil) (SETQ NN 2))
  49.     (SETQ F (OPEN "JD.DAT" "r"))
  50.     (SETQ WTH (READ (READ-LINE F)))
  51.     (SETQ WTH (READ (READ-LINE F)))
  52.     (SETQ WTH (READ (READ-LINE F)))
  53.     (CLOSE F)
  54.     (SETQ NN2 (/ (DISTANCE A B) NN))
  55.     (REPEAT NN
  56.         (QPMC1-1)
  57.         (SETQ A (POLAR A 1.5707963 NN2))
  58.     )
  59. )
  60.  
  61. (DEFUN C:QPM();1991-9-19
  62.     (SETVAR "CMDECHO" 0)
  63.     (SETVAR "OSMODE" 32)
  64. ;    (SETVAR "ORTHOMODE" 1)
  65.     (INITGET 1)
  66.     (SETQ A (GETPOINT "Input bas-point:" ))
  67.     (TERPRI)
  68.     (SETVAR "OSMODE" 0)
  69.     (SETQ E 1)
  70.     (TERPRI)
  71.     (SETQ FAB 1.5707963)
  72.     (INITGET 6)
  73.     (SETQ BL (GETDIST (POLAR A FAB E) "Input win-height<2100>: "))
  74.     (IF (= BL nil) (SETQ BL 2100))
  75.     (TERPRI)
  76.     (SETQ F (OPEN "JD.DAT" "r"))
  77.     (SETQ WTH (READ (READ-LINE F)))
  78.     (SETQ WTH (READ (READ-LINE F)))
  79.     (SETQ WTH (READ (READ-LINE F)))
  80.     (CLOSE F)
  81.     (QPMC1-1)
  82. )
  83. (DEFUN C:QPM1();1991-9-19
  84.     (SETVAR "CMDECHO" 0)
  85.     (SETVAR "OSMODE" 32)
  86. ;    (SETVAR "ORTHOMODE" 1)
  87.     (INITGET 1)
  88.     (SETQ A (GETPOINT "Input bas-point:" ))
  89.     (TERPRI)
  90.     (SETVAR "OSMODE" 0)
  91.     (SETQ E 1)
  92.     (TERPRI)
  93.     (SETQ FAB 1.5707963)
  94.     (INITGET 6)
  95.     (SETQ BL (GETDIST (POLAR A FAB E) "Input win-height<2100>: "))
  96.     (IF (= BL nil) (SETQ BL 2100))
  97.     (TERPRI)
  98.     (INITGET 6)
  99.     (SETQ B (GETPOINT A "Input next point: "))
  100.     (TERPRI)
  101.     (INITGET 6)
  102.     (SETQ NN (GETINT "Input window/door number <2>: "))
  103.     (IF (= NN nil) (SETQ NN 2))
  104.     (SETQ F (OPEN "JD.DAT" "r"))
  105.     (SETQ WTH (READ (READ-LINE F)))
  106.     (SETQ WTH (READ (READ-LINE F)))
  107.     (SETQ WTH (READ (READ-LINE F)))
  108.     (CLOSE F)
  109.     (SETQ NN2 (/ (DISTANCE A B) NN))
  110.     (REPEAT NN
  111.         (QPMC1-1)
  112.         (SETQ A (POLAR A 1.5707963 NN2))
  113.     )
  114. )
  115.  
  116. (DEFUN QPMC1-1()
  117.     (IF (NOT (EQUAL (GETVAR "CLAYER") "LMC"))
  118.         (COMMAND "LAYER" "M" "LMC" ""))
  119.     (SETQ B1 (POLAR A FAB E))
  120.     (SETQ A1 (POLAR B1 0 600))
  121.     (SETQ B1 (POLAR B1 3.1425926 600))
  122.     (SETQ S1 (SSGET "C" A1 B1))
  123.     (SETQ LE (SSLENGTH S1))
  124.     (SETQ I 0)
  125.     (WHILE (> LE I)
  126.         (SETQ E1 (ENTGET (SSNAME S1 I)))
  127.         (IF (= (CDR (ASSOC 0 E1)) "TRACE")
  128.             (SETQ I (1+ I));THEN
  129.             (PROGN
  130.                 (SSDEL (SSNAME S1 I) S1)
  131.                 (SETQ LE (1- LE))
  132.             )
  133.         )
  134.     )
  135.     (SETQ E1 (ENTGET (SSNAME S1 0)))
  136.     (SETQ E2 (ENTGET (SSNAME S1 1)))
  137. (SETQ XYD1 (INTERS A1 B1 (CDR (ASSOC 10 E1)) (CDR (ASSOC 12 E1))))
  138. (SETQ XYD2 (INTERS A1 B1 (CDR (ASSOC 11 E1)) (CDR (ASSOC 13 E1))))
  139. (SETQ I (INTERS A1 B1 (CDR (ASSOC 10 E2)) (CDR (ASSOC 12 E2))))
  140. (SETQ LE (INTERS A1 B1 (CDR (ASSOC 11 E2)) (CDR (ASSOC 13 E2))))
  141.     (SETQ A1 (DISTANCE XYD1 I))
  142.     (SETQ B1 (LIST XYD1 I))
  143.     (IF (> (DISTANCE XYD1 LE) A1) (PROGN
  144.         (SETQ A1 (DISTANCE XYD1 LE))
  145.         (SETQ B1 (LIST XYD1 LE))
  146.         )
  147.     )
  148.     (IF (> (DISTANCE XYD2 I) A1) (PROGN
  149.         (SETQ A1 (DISTANCE XYD2 I))
  150.         (SETQ B1 (LIST XYD2 I))
  151.         )
  152.     )
  153.     (IF (> (DISTANCE XYD2 LE) A1) (PROGN
  154.         (SETQ A1 (DISTANCE XYD2 LE))
  155.         (SETQ B1 (LIST XYD2 LE))
  156.         )
  157.     )
  158. (COMMAND "BREAK" (SSNAME S1 0) (CAR B1) (POLAR (CAR B1) FAB BL))
  159. (COMMAND "BREAK" (SSNAME S1 1) (CADR B1) (POLAR (CADR B1) FAB BL))
  160. (IF (EQUAL WTH nil) (SETQ WTH 50))
  161. (SETQ FAB1 (ANGLE (CAR B1) (CADR B1)))
  162.     (IF (< FAB1 FAB) (SETQ FAB1 (+ FAB1 6.2831853)))
  163.     (IF (OR (> (- FAB FAB1) -1.56) (< (- FAB FAB1) -1.58))
  164.         (SETQ B1 (REVERSE B1))
  165.     )
  166. (COMMAND "TRACE" WTH (POLAR (CADR B1) FAB (/ WTH -2))
  167.     (POLAR (CAR B1) FAB (/ WTH -2)) "")
  168. (COMMAND "TRACE" WTH (POLAR (CADR B1) FAB (+ BL (/ WTH 2)))
  169.     (POLAR (CAR B1) FAB (+ BL (/ WTH 2))) "")
  170.     (SETQ A1 (CAR B1))
  171.     (SETQ B1 (CADR B1))
  172.     (COMMAND "LINE" A1 (POLAR A1 FAB BL) "")
  173.     (COMMAND "LINE" B1 (POLAR B1 FAB BL) "")
  174.     (SETQ FAB (ANGLE A1 B1))
  175.     (SETQ A3 (DISTANCE A1 B1))
  176.     (SETQ A1 (POLAR A1 FAB (- (/ A3 2) (/ A3 7))))
  177.     (SETQ FAB (ANGLE B1 A1))
  178.     (SETQ B1 (POLAR B1 FAB (- (/ A3 2) (/ A3 7))))
  179.     (SETQ FAB 1.5707963)
  180.     (COMMAND "LINE" A1 (POLAR A1 FAB BL) "")
  181.     (COMMAND "LINE" B1 (POLAR B1 FAB BL) "")
  182. ;(SETQ A "Very good!")
  183. )
  184.