自定义清理
;|(Mpurge DOC'((groups t)(Layouts)(SelectionSets )(blocks)(layers)(textstyles)(dimstyles)(Linetypes)(Viewports)(Views)(UserCoordinateSystems)))清理Doc文档下的空组、删除布局、空选择集、清理未引用块、字体样式、标注样式、线型、视口、视图、ucs;
lst表每一项第一个为文档下的各种集合，出现第二项且非nilt时，清理该集合下的空对象，无第二项或第二项非真时，尽可能删除集合下所有对象;
DOC为当前CAD对象下的任一文档对象或dbx对象，doc为nil或非文档对象时，被自动设置为当前文档|;
(defun Mpurge(DOC LST / l n)
(or(not(VL-CATCH-ALL-ERROR-P(VL-CATCH-ALL-APPLY'vlax-get-property(List doc 'Database))))
(setq DOC(vlax-get-property(vlax-get-acad-object)'ActiveDocument)))
(vl-every(function(lambda(x / a b)
(or(VL-CATCH-ALL-ERROR-P(setq a(VL-CATCH-ALL-APPLY 'vlax-get-property(list doc(car x)))))
(progn(setq n(1+(vlax-get-property a'count)))
(while(<(setq l(vlax-get-property a'count))n)
(setq n l)
(vlax-for y a
(and(if(cdr x)(<(vlax-get-property y'count)1)t)
(VL-CATCH-ALL-APPLY 'vlax-invoke-method(list y 'delete))))))
t)))LST))
测试时，我换2台电脑用2006清理嵌套块出错，但其它版本CAD下测试正常，不知道究竟是电脑问题还是CAD2006的问题
;经过实测,楼主大大函数非常好用,感觉加一句"repeat"效果好一点
(setq LST '((layers)(groups t)(blocks)(blocks t)(textstyles)(dimstyles)) ;增加标注样式
(defun Mpurge (LST)
(repeat 3 ;一次好像清不干净,来3次
(vl-every
'(lambda (x / a b)
(or
(VL-CATCH-ALL-ERROR-P
(setq a (VL-CATCH-ALL-APPLY
'vlax-get-property
(list (vlax-get-property ;若用于dbx,修改此处
(vlax-get-acad-object)
'ActiveDocument
)
(car x)
)
)
)
)
(if (cdr x)
(vlax-for y a
(and
(< (vlax-get-property y 'count) 1)
(VL-CATCH-ALL-APPLY 'vlax-invoke-method (list y 'delete))
)
)
(vlax-for y a
(VL-CATCH-ALL-APPLY 'vlax-invoke-method (list y 'delete))
)
)
t
)
)
lst
)
);end repeat
)
repeat实际上是没必要的，但为什么会一次搞不干净，其实是相互牵扯，比如一个图层没有任何东西，但有一个未被参照的图块里边用到了该图层，那么在这个图块被清理前，这个图层是清理不掉的，另外文字样式也一样，就算图中没有任何文字或属性，但同样的一个块里边用到了这个文字样式，它同样也只能在块被清理之后才能被清理掉
这样一来，由于一次性清理没太考究顺序问题，所以就会理清不干净，需要repeat几次后它就干净了，实际上，注意一下顺序就可以一次清理干净
谢谢楼主耐心回复，这个程序最大的好处就是可以用来dbx，实现不开图批量清理。非常方便。这些天刚好在搜这个，搜遍全网，用lisp实现的就只看到1.2个，1个是楼主的，另外0.2个是MP的，他提供了伪源码。谢谢楼主大侠的经典源码！ 我怀疑这个清理功能可以用于dbx
(vlax-get-property(vlax-get-acad-object)'ActiveDocument)
这部分换成DBX对象就可以了
谢谢大佬,多日的疑惑或许马上就要解开,我先试验,这可是连沼泽MP都没具体回答的一个难题. 感谢大佬分享 收藏备用
页:
[1]