home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / LEI.LSP < prev    next >
Encoding:
Text File  |  1992-02-01  |  2.7 KB  |  83 lines
  1. (vmon)
  2.  
  3. (defun leierr(s)
  4.    (if (/= s "Function cancelled")
  5.        (princ (strcat "\nError:" s))
  6.    )
  7.    (command "layer" "s" "0" "")
  8.    (setvar "osmode" 0)
  9.    (setvar "cmdecho" 1)
  10.    (setq *error* oer)
  11.    (princ)
  12. )
  13.  
  14. (defun C:LEIS(/ oer sp ep p p1 p2 p3 elv loop lr ss sn en lw ang)
  15.    (setvar "cmdecho" 0)
  16.    (setq oer *error* *error* leierr)
  17.    (setq elv (getint "\n└╒╜╟╕▀ <450>:"))
  18.    (if (= elv nil) (setq elv 450))
  19.    (command "layer" "m" "sother" "")
  20.    (setq loop t)
  21.    (while loop
  22.       (setvar "osmode" 1)
  23.       (setq sp (getpoint "\n╞≡╩╝╡π:"))
  24.       (if (/= sp nil) (progn
  25.       (setq ep (getpoint sp "\n╓╒╓╣╡π:"))
  26.       (setvar "osmode" 0)
  27.       (if (= ep nil) (progn
  28.       (setq lr (strcase (getstring "\n╫≤├µL/╙╥├µ <R>:")))
  29.       (if (/= lr "L") (setq lr "R" ang 0) (setq ang pi)))) ;ep=nil
  30.       (setq ss (ssget sp))
  31.       (setq lw (* 0.5 (getvar "userr1")))
  32.       (if ss (progn
  33.       (setq sn (ssname ss 0) en (entget sn) ename (cdr (assoc 0 en)))
  34.       (if (= ename "POLYLINE") (setq lw (cdr (assoc 40 en))))
  35.       ))
  36.       (if (= ep nil) (progn
  37.       (setq p (polar sp ang (* 0.5 (getvar "userr1"))))
  38.       (setq p1 (polar p (* 1.5 pi) elv))
  39.       (setq p2 (polar p1 ang (* 25 (getvar "userr1"))))
  40.       (command "pline" sp "w" lw "" p p1 p2 "")
  41.       (setq p3 (polar p2 (+ ang pi) (* 5 (getvar "userr1"))))
  42.       (command "insert" (strcat "ELU" lr) p3 1 1 0 (rtos (- (/ elv 1000.0)) 2 3))
  43.       )
  44.       (command "pline" sp "w" lw "" ep "")
  45.       )
  46.       ) (setq loop nil))
  47.    )
  48.    (command "layer" "s" "0" "")
  49.    (setvar "osmode" 0)
  50.    (setvar "cmdecho" 1)
  51.    (setq *error* oer)
  52.    (princ)
  53. )
  54.  
  55. (defun C:LEIE(/ oer sp ep p p1 p2 p3 p4 p5 p6 p7 elv)
  56.    (setvar "cmdecho" 0)
  57.    (setq oer *error* *error* leierr)
  58.    (setq elv (getint "\n└╒╜╟╕▀ <450>:"))
  59.    (if (= elv nil) (setq elv 450))
  60.       (setvar "osmode" 1)
  61.       (setq sp (getpoint "\n╞≡╩╝╡π:"))
  62.       (setq ep (getpoint sp "\n╓╒╓╣╡π:"))
  63.       (setvar "osmode" 0)
  64.       (command "layer" "m" "eother" "")
  65.       (setq p sp)
  66.       (setq p1 ep)
  67.       (setq p2 (polar p (* 1.5 pi) elv))
  68.       (setq p3 (polar p1 (* 1.5 pi) elv))
  69.       (setq p4 (polar p2 pi (* 25 (getvar "userr1"))))
  70.       (setq p5 (polar p3 0 (* 25 (getvar "userr1"))))
  71.       (command "pline" p2 "w" 0 "" p p1 p3 "")
  72.       (command "pline" p4 "w" (* 0.6 (getvar "userr1")) "" p5 "")
  73.       (setq p6 (polar p4 0 (* 5 (getvar "userr1"))))
  74.       (command "insert" "elul" p6 1 1 0 (rtos (- (/ elv 1000.0)) 2 3))
  75.       (setq p7 (polar p5 pi (* 5 (getvar "userr1"))))
  76.       (command "insert" "elur" p7 1 1 0 (rtos (- (/ elv 1000.0)) 2 3))
  77.   (command "layer" "s" "0" "")
  78.   (setvar "osmode" 0)
  79.    (setvar "cmdecho" 1)
  80.    (setq *error* oer)
  81.    (princ)
  82. )
  83.