王伟，删除图层251内容
(defun qf_getFolder (msg / WinShell shFolder path catchit)
(vl-load-com)
(setq winshell (vlax-create-object "Shell.Application"))
(setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
(setq
catchit (vl-catch-all-apply
'(lambda ()
(setq shFolder (vlax-get-property shFolder 'self))
(setq path (vlax-get-property shFolder 'path))
)
)
)
(if (vl-catch-all-error-p catchit)
nil
path
)
)
;|函数功能: 获取目录下(包含子目录)里的某类型文件
;使用格式: a为路径名或多个路劲名表，b为扩展名
;范 例: (n5-get-files "D:" "lsp"),搜索d盘中所有lsp文件|;
;(setq c(n5-get-files b "dat"))
;(vl-file-directory-p b)返回T
;2016-6-11
;095
(defun n5-get-files(a b / lst mulu wj x )
(setq lst '())
(cond
((= (type a)'STR)
(if (setq wj (mapcar '(lambda(x)(strcat a "\\" x))(vl-directory-files a (strcat"*." b))))
(setq lst (cons wj lst)))
(if (setq mulu (mapcar '(lambda(x)(strcat a "\\" x))(cddr(vl-directory-files a nil -1))))
(foreach x mulu(setq lst(cons(n5-get-files x b) lst)))
)
)
((= (type a) 'list) (foreach x a (setq lst (cons(n5-get-files x b)lst))))
)
(reverse(apply 'append lst))
)
(defun lst-(l1 l2)(if l2(foreach x l2(setq l1(vl-remove x l1)))l1))
(defun c:tt(/ fp *DBX* COLORLST DBX DOC FILENAME FILENAME1 FILES LAY LAYLST LAYLSTS LAYNAMELST LAYNAMELSTS LAYS MSP NAMELST PATH SUBOBJ)
(setq *dbx* (strcat "ObjectDBX.AxDbDocument."(substr (getvar "acadver") 1 2)))
(setq colorlst(list 251 252));要保留的颜色列表
(setq path(QF_GETFOLDER"选择文件夹"))
(setq files(N5-GET-FILES path "dwg"))
(setq fp(open "c:\\你微笑时很美.txt" "w"))
(foreach file files
(write-line (strcat "当前:"file))
(setq filename(VL-FILENAME-MKTEMP nil nil ".dwg"))
(vl-file-copy file filename)
(setq dbx(vlax-get-or-create-object *dbx*))
(vla-open dbx filename)
(setq msp(vla-get-ModelSpace dbx))
(setq doc(vlax-get msp 'Document))
(setq lays(vla-get-layers doc))
(setq laylst nil laylsts laylst)
(vlax-for lay lays
(if (apply'or(mapcar(function(lambda(x)(= x (vla-get-color lay))))colorlst))
(setq laylst(cons lay laylst))
(if (= "0" (vla-get-name lay))(setq laylst(cons lay laylst))))
(setq laylsts(cons lay laylsts)))
(setq laynamelsts(mapcar'vla-get-name laylsts));全图层名字
(setq namelst(mapcar'vla-get-name laylst));要保留的图层的名字
(setq laynamelst(lst- laynamelsts namelst));要删除的图层的名字
(vlax-forsubobj msp
(if (apply'or(mapcar(function(lambda(x)(= x (vla-get-layer subobj))))laynamelst))
(vla-delete subobj)));删除图层上的图形
;;;(mapcar'vla-delete (lst- laylsts laylst));删除图层
(foreach x (lst- laylsts laylst)
(if(vl-catch-all-error-p(vl-catch-all-apply 'vla-delete (list x)))
(write-line (strcat file ""(vla-get-name x) "图层，删除失败")fp)
)
)
(setq filename1(VL-FILENAME-MKTEMP nil nil ".dwg"))
(vlax-invoke dbx 'saveas filename1)
(vlax-release-object dbx)
(vl-file-delete file)
(vl-file-copy filename1 file)
(vl-file-delete filename1)
)
(close fp)
(startapp"notepad" "c:\\你微笑时很美.txt")
(princ)
)
页:
[1]