home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / HM03.LSP < prev    next >
Encoding:
Text File  |  1991-04-08  |  4.1 KB  |  128 lines
  1. (defun input (sl m)
  2. ;(SETVAR "CMDECHO" 0)
  3.   (MENUCMD "S=IN1")
  4.  (initget (+ 1 2 4))
  5.   (setq l (getreal "\n╩Σ ╚δ │ñ ╢╚=: "))
  6.   (if (= sl 1)(setq l (rtos l)))
  7.   (if (= l "t")(setq l "T"))
  8.   (if (and (= sl 1) (/= l "T"))(setq l (atof l)))
  9.   (if (= l "T")(setq l (- m xb) l (/ l s)))
  10.   (if (= l "t")(setq l (- m xb) l (/ l s)))
  11.   (setq schl 0 xchl 0)
  12.   (MENUCMD "S=IN2")
  13.   (setq yn (getstring "\n╙╨ ╣½ ▓ε ╖±(N)? "))
  14.                                  (MENUCMD "S=IN1")
  15.   (if (= yn "")(setq yn "n" schl 0 xchl 0))
  16.   (if (or (= yn "y") (= yn "Y"))(progn
  17.                                  (setq schl (getreal "\n╔╧ ╞½ ▓ε=: "))
  18.                                  (setq xchl (getreal "\n╧┬ ╞½ ▓ε=: "))
  19.                                  )
  20.   )
  21.   (setq angl 0 angr 0)
  22.   (setq dgl (getreal "\n╫≤ ╡╣ ╜╟ │ñ ╢╚=:(0) "))
  23.   (if (null dgl)(setq dgl 0))
  24.   (if (> dgl 0)(setq angl (getreal "\n╫≤ ╡╣ ╜╟=: ")))
  25.   (if (= dgl 0)(progn
  26.   (setq dgl (getreal "\n╫≤ ╡╣ ╘▓ ┴┐=:(0) "))
  27.   (if (null dgl)(setq dgl 0))
  28.   (if (/= dgl 0)(setq dgl (- 0 dgl)))
  29. ))
  30.   (setq dgr (getreal "\n╙╥ ╡╣ ╜╟ │ñ ╢╚=:(0) "))
  31.   (if (null dgr)(setq dgr 0))
  32.   (if (> dgr 0)(setq angr (getreal "\n╙╥ ╡╣ ╜╟=: ")))
  33.   (if (= dgr 0)(progn
  34.   (setq dgr (getreal "\n╙╥ ╡╣ ╘▓ ┴┐=:(0) "))
  35.   (if (null dgr)(setq dgr 0))
  36.   (if (/= dgr 0)(setq dgr (- 0 dgr)))
  37. ))
  38. (setq yn "")
  39.     (MENUCMD "S=SCREEN")
  40. )
  41. ;**************************************************************
  42. ;* The function for drwing taper.                             *
  43. ;**************************************************************
  44. (defun cone (sl m)
  45. ;(SETVAR "CMDECHO" 0)
  46.   (MENUCMD "S=IN2")
  47.   (setq da 0)
  48. (setq yn (getstring "\n▒Ω ╫╝ ╫╢ ╢╚ ╖± ? (Y)"))
  49. (setq k2 " ")
  50. (if (or (= yn "Y") (= yn "y") (= yn ""))
  51.  (PROGN
  52.  (MENUCMD "S=TA1")
  53.  (initget (+ 1 2 4))
  54.  (setq k (getstring "\n╤í ╘± ╫╢ ╢╚(1:3 1:5...7:24...M.1 M.2 M.3....):"))
  55.  (setq k1 k k2 k)
  56.  (if (or (= k "M.1") (= k "M.0") (= k "M.2") (= k "M.3") (= k "M.4") (= k "M.5") (= k "M.6") (= k "m.0") (= k "m.1") (= k "m.2" ) (= k "m.3") (= k "m.4") (= k "m.5") (= k "m.6"))(setq k "1:20" tz "m"))
  57.  (setq k (substr k 3))
  58.  (setq k (atof k))
  59.  (setq k1 (substr k1 3))
  60.  (setq k1 (atoi k1))
  61.   (MENUCMD "S=IN2")
  62.  (initget 1 "l L r R")
  63.  (setq lr (getkword "\n┤≤ ╢╦ ╘┌ ╫≤(L) ╗≥ ╙╥(R)? "))
  64.   (MENUCMD "S=IN1")
  65.  (if (/= tz "m")
  66.     (progn
  67.  (initget (+ 1 2 4))
  68.    (setq dr (getreal "\n╩Σ ╚δ ┤≤ ╢╦ ╓▒ ╛╢=: "))
  69.        )
  70.  )
  71.  (if (= tz "m")(setq dr1 (nth k1 '("9.045" "12.065" "17.780" "23.825" "31.267" "44.399" "63.348"))))
  72.  (if (= tz "m")(setq dr (atof dr1)))
  73.   (input sl m)
  74.   (if (or (= lr "L") (= lr "l"))(setq dl dr))
  75.   (if (or (= lr "L") (= lr "l"))(setq dr (- dl (/ l k)))(setq dl (- dr (/ l k))))
  76.   (if (and (or (= lr "L") (= lr "l")) (= k 24))(setq dr (- dl (/ (* 7 l) k))))
  77.   (if (and (or (= lr "R") (= lr "r")) (= k 24))(setq dl (- dr (/ (* 7 l) k))))
  78.   (setq ll 2.0)
  79. ))
  80. (if (or (= yn "n") (= yn "N"))(progn
  81.        (MENUCMD "S=IN1")
  82.        (initget (+ 1 2 4))
  83.        (setq dl (getreal "\╩Σ╚δ╫≤╓▒╛╢=:"))
  84.        (initget (+ 1 2 4))
  85.        (setq dr (getreal "\n╩Σ╚δ╙╥╓▒╛╢=:"))
  86.         (input sl m)
  87.        (setq ll 0.0)
  88. ))
  89.   (setq dl1 dl dr1 dr l1 l dgl1 dgl dgr1 dgr)
  90.   (setq dl (* (/ dl 2) s) dr (* (/ dr 2) s) l (* l s))
  91.   (if (< dgl 0)(setq dgl 0))
  92.   (if (< dgr 0)(setq dgr 0))
  93.   (setq dgl (* dgl s) dgr (* dgr s))
  94.   (dbsa1 xb sl)
  95.   (setq fpt (list xb yb))
  96.   (attdef2)
  97.   (attdef1 "gpsz1" "G" fpt)
  98.   (attdef1 "dgch1" k2 fpt)
  99.   (attdef1 "ll1" ll fpt)
  100.     (MENUCMD "S=SCREEN")
  101. )
  102. ;**************************************
  103. ;*  The function for drwing taper.    *
  104. ;**************************************
  105. (DEFUN TAPER ()
  106. (SETVAR "CMDECHO" 0)
  107. (setvar "blipmode" 0)
  108. (cone 0 0)
  109. (FN)
  110. (setq dl (max dl dr))
  111.  (if (= nol no)
  112. (command "block" no "Y" fpt "w" (list xb (- yb dl)) (list (+ xb l) (+ yb dl)) "")
  113. (command "block" no fpt "w" (list xb (- yb dl)) (list (+ xb l) (+ yb dl)) "")
  114. )
  115. (command "insert" no fpt "" "" "" "" "" "" "" "" "" "" "" "" "" "" "")
  116. (setq xb (+ xb l))
  117. ;(redraw)
  118. (MENUCMD "S=IN2")
  119. (SETQ YN (GETSTRING "\n╩╟╖±╝╠╨°╗¡═Γ▒φ├µ: "))
  120. (IF (OR (= YN "Y") (= YN "y") (= YN ""))
  121.  (PROGN(MENUCMD "I=YY")
  122.        (MENUCMD "I=*")
  123.  )
  124.                (MENUCMD "S=SCREEN")
  125. )
  126. )
  127. (TAPER)
  128.