带有描述的图层列表
我有一个例程(作者不知道),可以将图形中现有图层的列表导出到文本文件。它工作得很好,但我想要一个版本,可以包括一列描述每一层。提前感谢您可能提供的帮助。
(defun c:LL2T ( / oecho clrlst dwgnm fn fh lyr lyrlst)
(defun chkbit (bit_val num)
(not (zerop (logand bit_val num)))
)
(setq
oecho (getvar "cmdecho")
clrlst (list
(cons 1 "RED")
(cons 2 "YELLOW")
(cons 3 "GREEN")
(cons 4 "CYAN")
(cons 5 "BLUE")
(cons 6 "MAGENTA")
(cons 7 "WHITE")
)
dwgnm (getvar "dwgname")
)
(setvar "cmdecho" 0)
(setq fn (getfiled " File name: " (strcat dwgnm ".LS") "LS" (+ 1 2))
)
(while (setq lyr (tblnext "layer" (not lyr)))
(setq lyrlst (cons (cdr (assoc 2 lyr)) lyrlst))
)
(setq lyrlst (acad_strlsort lyrlst))
(princ "\nWriting layer data to file...")
(setq fh (open fn "w"))
(princ (strcat dwgnm ".DWG\n") fh)
(foreach x lyrlst
(setq
lyr (tblsearch "layer" x)
lyrname (cdr (assoc 2 lyr))
lyrclr (cdr (assoc 62 lyr))
lyrlt (cdr (assoc 6 lyr))
frzn? (chkbit 1 (cdr (assoc 70 lyr)))
lokd? (chkbit 4 (cdr (assoc 70 lyr)))
)
(if (minusp lyrclr)
(setq
on? "OFF"
lyrclr (abs lyrclr)
)
(setq on? "ON")
)
(if (assoc lyrclr clrlst)
(setq lyrclr (cdr (assoc lyrclr clrlst)))
)
(if frzn?
(setq frzn? "FROZEN")
(setq frzn? "THAWED")
)
(if lokd?
(setq lokd? "LOCKED")
(setq lokd? "UNLOCKED")
)
(princ lyrname fh)
;;(princ "," fh)
;;(princ lyrclr fh)
;;(princ "," fh)
;;(princ lyrlt fh)
;;(princ "," fh)
;;(princ on? fh)
;;(princ "," fh)
;;(princ frzn? fh)
;;(princ "," fh)
;;(princ lokd? fh)
(princ "\n" fh)
)
(princ "done.")
(close fh)
(setvar "cmdecho" oecho)
(princ)
)
页:
[1]