我有一个例程(作者不知道),可以将图形中现有图层的列表导出到文本文件。它工作得很好,但我想要一个版本,可以包括一列描述每一层。
提前感谢您可能提供的帮助。
- (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)
- )
|