home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / FTOL.LSP < prev    next >
Encoding:
Text File  |  1992-01-30  |  1.5 KB  |  46 lines
  1. (defun ftolerr(s)
  2.   (if (/= s "Function cancelled")
  3.       (princ (strcat "\nError:" s))
  4.   )
  5.   (command "undo" "end")
  6.   (command "layer" "s" "0" "")
  7.   (setvar "cmdecho" 1)
  8.   (setq *error* oer)
  9.   (princ)
  10. )
  11.  
  12. (defun c:ftol(/ oer ss sn en ssl n ename elay clay ccol ecol p10 p11 p12 p13)
  13.    (setvar "cmdecho" 0)
  14.    (setvar "elevation" 0)
  15.    (setvar "thickness" 0)
  16.    (setq oer *error* *error* ftolerr)
  17.    (command "ucs" "w")
  18.    (setq ss (ssget))
  19.    (if ss (progn
  20.      (setq ssl (sslength ss) n 0)
  21.      (repeat ssl
  22.        (setq sn (ssname ss n) en (entget sn))
  23.        (setq ename (cdr (assoc 0 en)) elay (cdr (assoc 8 en)))
  24.        (setq ccol (getvar "cecolor") clay (getvar "clayer"))
  25.        (if (and (= "3DFACE" ename) (not (or (= elay "TWINDOW") (= elay "TDOOR")))) (progn
  26.          (setq ecol (cdr (assoc 62 en)))
  27.          (if (not (= ecol ccol))
  28.             (if (not (= ecol nil)) (command "color" ecol) (command "color" "bylayer"))
  29.          )
  30.          (if (not (= elay clay)) (command "layer" "s" elay ""))
  31.          (setq p10 (cdr (assoc 10 en)) p11 (cdr (assoc 11 en)))
  32.          (setq p12 (cdr (assoc 12 en)) p13 (cdr (assoc 13 en)))
  33.          (command "ucs" "e" sn)
  34.          (entdel sn)
  35.          (command "line" (trans p10 0 1) (trans p11 0 1) (trans p12 0 1) (trans p13 0 1) (trans p10 0 1) "")
  36.       ))
  37.       (setq n (1+ n))
  38.       )
  39.    ))
  40.    (command "layer" "s" "0" "")
  41.    (command "ucs" "w")
  42.    (setq *error* oer)
  43.    (setvar "cmdecho" 1)
  44.    (princ)
  45. )
  46.