home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / CENLINE.LSP < prev    next >
Encoding:
Text File  |  1989-11-24  |  1.5 KB  |  44 lines
  1. (DEFUN CENLINE1 ()
  2. (COMMAND "OSNAP" "NEAREST")
  3. (setq str1 (getpoint "\n╙├ ╩« ╫╓ ╧▀ ╢¿ ╗∙ ├µ ╬╗ ╓├: "))
  4. ;(setq str1 (osnap str "nea"))
  5. (setq x1 (car str1) y1 (cadr str1) sc 0 bat 0)
  6. (if (= (fix y1) (fix yb))(setq bat 1)(setq bat 2))
  7. (MENUCMD "S=IN1")
  8. (setq l (getreal "\n╡╜ ╗∙ ├µ ╛α └δ=: "))
  9. (setq FPT (getpoint "\n╙├ ╩« ╫╓ ╧▀ ╢¿ ╞≡ ╩╝ ├µ:"))
  10. ;(setq fpt (osnap str "nea"))
  11. (setq xg (car fpt) yf (cadr fpt) l1 l l (* l s))
  12. (setq ept (getpoint "\n╙├ ╩« ╫╓ ╧▀ ╢¿ ╓╒ ╓╣ ├µ: "))
  13. (COMMAND "OSNAP" "NONE")
  14. (setq xe (car ept) ye (cadr ept) ll 1 lk 0)
  15. (if (= bat 2)(progn
  16. (if (> yf ye)(setq sc bat))
  17. (if (< yf ye)(setq sc (+ bat 3)))
  18. ))
  19. (if (= bat 1)(progn
  20. (if (> xe xg)(setq sc bat))
  21. (if (< xe xg)(setq sc (+ bat 3)))
  22. ))
  23. (if (or (= sc 1) (= sc 2))(setq tg 0.1)(setq tg (- 0 0.1)))
  24. (if (or (= sc 1) (= sc 4))(setq tof (list (- xg tg) (+ yb l)) toe (list (+ xe tg) (+ yb l))))
  25. (if (or (= sc 2) (= sc 5))(setq tof (list (+ x1 l) (+ yf tg)) toe (list (+ x1 l) (- ye tg))))
  26. (if (and (= yf ye) (= xg xe))(setq sc 3))
  27. (if (/= l 0)(setq ll (getreal "\n┐╫ ╡─ ╕÷ ╩²=: ")))
  28. (if (and (/= l 0) (/= sc 2))(setq lk (getreal "\n┐╫ ╙δ ╓╨ ╨─ ╝╨ ╜╟=: ")))
  29. )
  30. ;**************************************
  31. ;*  The program for drawing centerline.*
  32. ;***************************************
  33. (DEFUN CENLINE ()
  34. (SETVAR "CMDECHO" 0)
  35. (command "layer" "n" "f6" "s" "f6" "l" "dashdot" "" "color" "1" "" "")
  36. (cenline1)
  37. (command "line" tof toe "")
  38. (command "layer" "n" "f8" "s" "f8" "l" "hidden" "" "color" "4" "" "")
  39. (redraw)
  40. (MENUCMD "I=DD")
  41. (MENUCMD "I=*")
  42. )
  43. (CENLINE)
  44.