删除标注线和图层的问题

misters

我写了一个删除图层的程序，不管用，执行完了，没有任何错误，但无有的图层都在，跟没执行一样，大家帮我看一下 Dim obj As AcadObject
Dim acadDoc As Object

For Each obj In acadApp.ActiveDocument.ModelSpace
obj.Layer = "0"
If obj.ObjectName = "AcDbBlockReference" Then
obj.Explode
End If
Next
首先把所有的对象都放到0层，把块都打碎 下面是删除图层 acadApp.ActiveDocument.ModelSpace.PurgeAll
Dim layerobj As AcadLayer
Dim str As String
Dim i As Long

For i = 0 To acadApp.ActiveDocument.Layers.Count
str = acadApp.ActiveDocument.Layers(i).Name
If str <> "0" Then acadApp.ActiveDocument.Layers(i).Delete
Next
有好方法的请提供代码，方法我知道，但不会写 怎么把图形中所有的标注删掉啊？ 两个问题，切盼回复

wyj7485

For each layerobj in acadApp.ActiveDocument.Layers
If layerobj .name <> "0" Then layerobj .Delete
Next

misters

这段程序是建立一个选择集，将标注对象加入选择集，把所有的标注都删除 当然，有更好的办法更好，请看一下下面的代码 Set ACADapp = GetObject(, "AutoCAD.Application")
Set ACADdoc = ACADapp.ActiveDocument
Dim ssetObj As AcadSelectionSet
ACADapp.ActiveDocument.SelectionSets("TEST_SELECTIONSET").Delete
Set ssetObj = ACADapp.ActiveDocument.SelectionSets.Add("TEST_SELECTIONSET")

Dim i As Long
Dim obj As AcadObject i = 0
For Each obj In ACADapp.ActiveDocument.ModelSpace '遍历工作区中的实体
Select Case obj.EntityName
Case "AcDbMText", "AcDbText", "AcDbRadialDimension", "AcDb3PointAngularDimension", "AcDbRotatedDimension", "AcDbAlignedDimension", "AcDbOrdinateDimension", "AcDbFcf", "AcDbLeader"
i = i + 1
Case Else
End Select
Next obj MsgBox i
ReDim ssobjs(0 To i) As AcadEntity i = 0
For Each obj In ACADapp.ActiveDocument.ModelSpace '遍历工作区中的实体
Select Case obj.EntityName
Case "AcDbMText", "AcDbText", "AcDbRadialDimension", "AcDb3PointAngularDimension", "AcDbRotatedDimension", "AcDbAlignedDimension", "AcDbOrdinateDimension", "AcDbFcf", "AcDbLeader"
Set ssobjs(i) = ACADapp.ActiveDocument.ModelSpace.Item(i)
i = i + 1
Case Else
End Select Next obj
MsgBox i

ssetObj.AddItems ssobjs '这句老提示空对象指针,是怎么回事

ssetObj.Erase

misters

非常感谢2楼的

wyj7485

删出标注为什么要这样呢? 直接遍历工作区中的实体,删出标注就可以了啊!

misters

那5楼的提供个代码，供参考一下好吗？

wyj7485

你的这段就是啊: For Each obj In ACADapp.ActiveDocument.ModelSpace '遍历工作区中的实体
Select Case obj.EntityName
Case "AcDbMText", "AcDbText", "AcDbRadialDimension", "AcDb3PointAngularDimension", "AcDbRotatedDimension", "AcDbAlignedDimension", "AcDbOrdinateDimension", "AcDbFcf", "AcDbLeader"
'Set ssobjs(i) = ACADapp.ActiveDocument.ModelSpace.Item(i)
obj.delete
Case Else
End Select Next obj

misters

谢了，我试试