caizhiming 发表于 2008-1-29 23:22:00

[求助]删除图层

<p><font size="4">请为VBA或LISP怎么样才可以达到以下目的：</font></p><p><strong><font size="3">1、打开一个CAD文件，</font></strong></p><p><strong><font size="3">2、删除文件中的一个层（该层可能包含实体），</font></strong></p><p><strong><font size="3">3、另存文件。</font></strong></p><p><font color="#ff0000" size="3"><strong>以上功能要批量进行！！</strong></font></p><p><font size="5">请高手指点。谢谢！！</font></p>

gdzhou 发表于 2008-2-14 23:18:00

<p>这个用SCR脚本就可以实现呵呵</p><p>这种单一的功能，编个程序有点大材小用了。。</p><p>用DOS编个批处理吧。。</p><p>嘻嘻</p><p></p>

style6301 发表于 2008-3-7 16:23:00

<p>如何实现，请写明，并最好有注解</p>

千度Show颖 发表于 2012-9-7 09:23:46

嗯，希望那个高手把代码弄出来

千度Show颖 发表于 2012-9-7 09:25:06

我急着用，急

sscylh 发表于 2012-9-10 20:26:33

千度Show颖 发表于 2012-9-7 09:25 static/image/common/back.gif
我急着用，急

Sub aa()
Dim s As String
On Error Resume Next
Dim la As AcadLayer
s = InputBox("请输入图层名称")
Set la = ThisDrawing.Layers("0")
ThisDrawing.Layers(s).Lock = False
ThisDrawing.Layers(s).Freeze = False


For i = 1 To ThisDrawing.ModelSpace.Count
If ThisDrawing.ModelSpace(i - 1).Layer = s Then
ThisDrawing.ModelSpace(i - 1).Delete
End If
Next
ThisDrawing.ActiveLayer = la
ThisDrawing.Layers(s).Delete
ThisDrawing.SaveAs "d:/hello.dwg"
Application.Quit
End Sub

yuanji007 发表于 2012-10-13 20:31:08

.delete   .save as

yanyanjun999 发表于 2012-10-13 21:15:04

斑竹这个程序蛮好的，收藏了
页: [1]
查看完整版本: [求助]删除图层