home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p067 / 2.img / HD / HDD76.LSP < prev    next >
Encoding:
Text File  |  1994-01-31  |  5.2 KB  |  171 lines
  1. (defun HDD76 ()
  2. (setvar "CMDECHO" 0)
  3. (command "vslide" "\\house1\\sld\\s76")
  4.        (setq f 0)
  5.        (setq f1 0)
  6.        (while (and (/= f "E") (/= f "e"))
  7.               (setq f1 (getstring "\n╩Σ╚δ╝╞╦π╧ε <1-3>: "))
  8.               (cond ((= f1 "1") (PCR))
  9.                     ((= f1 "2") (Cosfi))
  10.                     ((= f1 "3") (Select))
  11.               )
  12.               (setq f (getstring "\n╝╠╨°╝╞╦π<C>╗≥╜ß╩°<E>: "))
  13.        )
  14. (command "redraw")
  15. (print "end")
  16. )
  17. (defun PCR ()
  18.        (setq f2 0)
  19.        (setq f3 0)
  20.        (while (and (/= f2 "S1") (/= f2 "s1"))
  21.        (setq f3 (getint "╩Σ╚δ╝╞╦π╧ε <1-2>: "))
  22.        (cond ((= f3 1) (ab))
  23.              ((= f3 2) (ba))
  24.        )
  25.        (setq f2 (getstring "\n╝╠╨°╝╞╦π<C> ╗≥═╦│÷<S1>: "))
  26.        )
  27. )
  28. (defun ab ()
  29.       (setq Qc 0)
  30.        (setq Pjs (getreal "\n╩Σ╚δ Pjs= "))
  31.        (setq tanfi1 (getreal "\n╩Σ╚δ tanfi1= "))
  32.        (setq tanfi2 (getreal "\n╩Σ╚δ tanfi2= "))
  33.        (setq Qc (* 0.725 (* Pjs (- tanfi1 tanfi2))))
  34.        (setq qc3 qc)
  35.        (setq Q "Qc= ")
  36.        (setq Qca (strcat Q (rtos Qc 2 4)))
  37.        (print Qca)
  38. )
  39. (defun ba()
  40.        (setq Wm (getreal "\n╩Σ╚δ Wm= "))
  41.        (setq Kjm (getreal "\n╩Σ╚δ Kjm= "))
  42.        (setq tanfi1 (getreal "\n╩Σ╚δ tanfi1= "))
  43.        (setq tanfi2 (getreal "\n╩Σ╚δ tanfi2= "))
  44.        (setq fm (getreal "\n╩Σ╚δ fm= "))
  45.        (setq Qc2 (/ (* Wm (* Kjm (- tanfi1 tanfi2))) fm))
  46.        (setq qc4 qc2) (setq qc3 qc2)
  47.        (setq Q "Qc2= ")
  48.        (setq Qcb (strcat Q (rtos Qc2 2 4)))
  49.        (print Qcb)
  50. )
  51. (defun Cosfi ()
  52.        (setq f4 0) 
  53.        (setq f5 0) 
  54.        (setq Tx '())
  55.        (while (and (/= f4 "S2") (/= f4 "s2"))
  56.               (setq f5 (getint "╩Σ╚δ╝╞╦π╧ε<1-3>: "))
  57.               (cond ((= f5 1) (cos1))
  58.                     ((= f5 2) (cos2))
  59.                     ((= f5 3) (cos3))
  60.              )
  61.              (setq f4 (getstring "\n╝╠╨°╝╞╦π<C> ╗≥═╦│÷<S2>: "))
  62.       )
  63. )
  64. (defun cos1 ()
  65.        (setq Bn (getreal "\n╩Σ╚δ Bn= "))
  66.        (setq Tx (cons Bn Tx))
  67.        (setq Qjs (getreal "\n╩Σ╚δ Qjs= "))
  68.        (setq Tx (cons Qjs Tx))
  69.        (setq Pjs (getreal "\n╩Σ╚δ Pjs= "))
  70.        (setq Tx (cons Pjs Tx))
  71.        (setq an (getreal "\n╩Σ╚δ an= "))
  72.        (setq Tx (cons an Tx))
  73.        (setq L (open "yu.tst" "w"))
  74.        (setq Tx (reverse Tx))
  75.        (print Tx L)
  76.        (close L)
  77.        (setq f6 (/ (* Bn Qjs) (* an Pjs)))
  78.        (setq f7 (/ 1 (+ (* f6 f6) 1)))
  79.        (setq f8 (sqrt f7))
  80.        (setq Q "Cosfi1= ")
  81.               (setq Cosfi1 (strcat Q (rtos f8 2 4)))
  82.               (print cosfi1)
  83. )
  84. (defun cos2 ()
  85.        (cond ((= Qc3 nil) (ab)))
  86.        (cond ((= Qc4 nil) (ba)))
  87.        (setq L (open "yu.tst" "r"))
  88.        (read-line L)
  89.        (setq Tx1 (read (read-line L)))
  90.        (setq Bn (nth 0 Tx1))
  91.        (setq Qjs (nth 1 Tx1))
  92.        (setq Pjs (nth 2 Tx1))
  93.        (setq an (nth 3 Tx1))
  94.        (close L)
  95.        (setq f9 (/ (- (* Bn Qjs) Qc3) (* an Pjs)))
  96.        (setq f10 (/ 1 (+ (* f9 f9) 1)))
  97.        (setq f11 (sqrt f10))
  98.        (setq Q "cosfi2= ")
  99.        (setq cosfi2 (strcat Q (rtos f11 2 4)))
  100.        (print cosfi2)
  101. )
  102. (defun cos3 ()
  103.        (setq Wm (getreal "\n╩Σ╚δ Wm= "))
  104.        (setq f12 Wm)
  105.        (setq Wm (* Wm Wm))
  106.        (setq Wrm (getreal "\n╩Σ╚δ Wrm= "))
  107.        (setq Wrm (* Wrm Wrm))
  108.        (setq Cosfi3 (/ f12 (sqrt (+ Wm Wrm))))
  109.        (setq Q "Cosfi3= ")
  110.        (setq Cosfi3 (strcat Q (rtos Cosfi3 2 4)))
  111.        (print Cosfi3)
  112. )
  113. (defun Select ()
  114.        (setq f13 0)
  115.        (setq f14 0)
  116.        (setq Tx3' ())
  117.        (while (and (/= f13 "S3") (/= f13 "s3"))
  118.               (setq f14 (getint "╩Σ╚δ╝╞╦π╧ε<1-2>: "))
  119.               (cond ((= f14 1) (RL))
  120.                     ((= f14 2) (RL1))
  121.               )
  122.        (setq f13 (getstring "\n╝╠╨°╝╞╦π<C> ╗≥═╦│÷<S3>: "))
  123.       )
  124. )
  125. (defun RL ()
  126.        (setq Qjs (getreal "\n╩Σ╚δ QJs= "))
  127.        (setq Tx3 (cons Qjs Tx3))
  128.        (setq Ad (getreal "\n╩Σ╚δ Ad= "))
  129.        (setq Tx3 (cons Ad Tx3))
  130.        (setq Ag (getreal "\n╩Σ╚δ Ag= "))
  131.        (setq Tx3 (cons Ad Tx3))
  132.        (setq Ud (getreal "\n╩Σ╚δ Ud= "))
  133.        (setq Ud (* Ud Ud))
  134.        (setq Tx3 (cons Ud Tx3))
  135.        (setq nb (getreal "\n╩Σ╚δ nb= "))
  136.        (setq Tx3 (cons nb Tx3))
  137.        (setq F (getreal "\n╩Σ╚δ F= "))
  138.        (setq Tx3 (cons F Tx3))
  139.        (setq Ta (getreal "\n╩Σ╚δ Ta= "))
  140.        (setq Tx3 (cons Ta Tx3))
  141.        (setq R (getreal "\n╩Σ╚δ R= "))
  142.        (setq Tx3 (cons R Tx3))
  143.        (setq Tx3 (reverse Tx3))
  144.        (setq L1 (open "yu1.tst" "w"))
  145.        (print Tx3 L1)
  146.        (close L1)
  147.        (setq f16 (/ (* Ud (* 1000 (- Ad Ag))) (* nb (* F (* Ta R)))))
  148.        (setq Qkh (- (* 2 Qjs) f16))
  149.        (setq Q "Qkh= ")
  150.        (setq Qkh (strcat Q (rtos Qkh 2 4)))
  151.        (print Qkh)
  152. )
  153. (defun RL1 ()
  154.        (setq L1 (open "yu1.tst" "r"))
  155.        (read-line L1)
  156.        (setq Tx2 (read (read-line L1)))
  157.        (setq Qjs (nth 0 Tx2))
  158.        (setq Ad (nth 1 Tx2))
  159.        (setq Ag (nth 2 Tx2))
  160.        (setq Ud (nth 3 Tx2))
  161.        (setq nb (nth 4 Tx2))
  162.        (setq f (nth 5 Tx2))
  163.        (setq Ta (nth 6 Tx2))
  164.        (setq R (nth 7 Tx2))
  165.        (setq f18 (/ (* Ud (* (- Ad Ag) 10000)) (* 2 (* nb (* f (* Ta R))))))
  166.        (setq Qkh1 (- Qjs f18))
  167.        (setq Qkh1 (strcat Q (rtos Qkh1 2 4)))
  168.        (print Qkh1)
  169. )
  170. (hdd76)
  171.