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