home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / T.LSP < prev    next >
Encoding:
Text File  |  1990-07-20  |  1.2 KB  |  38 lines
  1. (princ "╫░╚δ TRACE - LINE │╠╨≥")
  2. (princ)
  3. (DEFUN C:TTL ()
  4.    (SETVAR "PICKBOX" 2)
  5.    (setq ln (strcase (getstring "\n╟δ╩Σ╚δ┤╓╧▀╦∙╘┌╡─▓π├√:")))
  6.    (command "layer" "s" ln "")
  7.    (SETQ e (entnext) l nil i 1)
  8.    (while e
  9.       (if (= (cdr (assoc 0 (entget e))) "TRACE")
  10.         (progn (setq pt1 (cdr (assoc 10 (entget e))))
  11.                (setq pt3 (cdr (assoc 11 (entget e))))
  12.                (setq pt2 (cdr (assoc 12 (entget e))))
  13.                (setq pt4 (cdr (assoc 13 (entget e))))
  14.                (if (not (equal pt1 pt3))
  15.                (progn
  16.                (setq pt (polar pt1 (angle pt1 pt3) (/ (distance pt1 pt3) 2)))
  17.                (setq pt1(polar pt2 (angle pt2 pt4) (/ (distance pt2 pt4) 2)))
  18.                (princ (strcat "\n╒╥╡╜┴╦╡┌<" (itoa i) ">╕÷TRACE╩╡╠σ."))
  19.                (setq i (1+ i))
  20.                (setq l (cons (list pt pt1) l))
  21.                (entdel e)
  22.                ))
  23.        ))
  24.         (setq e (entnext e))
  25.    )
  26.    (command "'redraw")
  27.    (setq n (length l)
  28.          i 0)
  29.    (while (< i n)
  30.       (setq pt (car (nth i l)))
  31.       (setq pt1 (cadr (nth i l)))
  32.       (command "line" pt pt1 "")
  33.       (setq i (1+ i))
  34.     )
  35. )
  36. (princ "\n│╠╨≥╫░╚δ┴╦ ..")
  37. (princ)
  38.