home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / HM19.LSP < prev    next >
Encoding:
Text File  |  1991-04-09  |  1.4 KB  |  50 lines
  1. ;****************************************
  2. ;*  The program for drawing undercut.   *
  3. ;****************************************
  4. (DEFUN HCUT ()
  5. (SETVAR "CMDECHO" 0)
  6. (SETVAR "BLIPMODE" 0)
  7. (MENUCMD "S=IN2")
  8. (initget 1 "l L r R")
  9. (setq ed (getkword "\n╤╙╔∞╖╜╧≥ : ╫≤ (L) / ╙╥ (R) "))
  10. (MENUCMD "S=IN1")
  11.  (initget (+ 2 4))
  12. (setq kd (getreal "\n╚⌠ ╧┬ ╢╬ ╓▒ ╛╢ ┤≤,╘≥ ╩Σ ╚δ ╧┬ ╢╬ ╓▒ ╛╢ (╖± ╘≥ ╗╪ │╡)"))
  13. (if (null kd)(setq kd dr))
  14. (if (/= kd dr)(setq kd (* (/ kd 2) s)))
  15.  (initget (+ 1 2 4))
  16. (setq l (getreal "\n┐╒ ╡╢ ▓█ ┐φ ╢╚=: "))
  17.  (initget (+ 1 2 4))
  18. (setq h (getreal "\n┐╒ ╡╢ ▓█ ╔ε ╢╚=: "))
  19. (setq z h l1 l h (* h s) l (* l s))
  20. (setq dr (+ kd h) dl dr dgl 0 dgr 0)
  21. (dbsa1 xb 0)
  22. (FN)
  23. (attdef1 "l1" l1 fpt)
  24. (attdef1 "ll1" z fpt)
  25. (attdef1 "gpsz1" "K" fpt)
  26.  (if (or (= ed "L")(= ed "l"))
  27. (attdef1 "dir1" "F" fpt)
  28. (attdef1 "dir1" "H" fpt)
  29.    )
  30.  (if (or (= ed "L")(= ed "l"))
  31.   (setq w1 (list (- xb l) (- yb dr)) w2 (list xb (+ yb dr)))
  32.   (setq w1 (list xb (- yb dr)) w2 (list (+ xb l) (+ yb dr)))
  33.  )
  34.  (if (= nol no)
  35.    (command "block" no "Y" fpt "w" w1 w2 "")
  36.    (command "block" no fpt "w" w1 w2 "")
  37.  )
  38. (command "insert" no fpt "" "" "" "" "" "" "")
  39.    (XB1)
  40. (MENUCMD "S=IN2")
  41. (SETQ YN (GETSTRING "\n╩╟╖±╝╠╨°╗¡─┌▒φ├µ: "))
  42. (IF (OR (= YN "Y") (= YN "y") (= YN ""))
  43.  (PROGN(MENUCMD "I=nn")
  44.        (MENUCMD "I=*")
  45.  )
  46.  (MENUCMD "S=SCREEN")
  47. )
  48. )
  49. (HCUT)
  50.