社区 › VB › 删除标注线和图层的问题

misters 发表于 2005-6-2 16:46:00

删除标注线和图层的问题

我写了一个删除图层的程序，不管用，执行完了，没有任何错误，但无有的图层都在，跟没执行一样，大家帮我看一下
                       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
有好方法的请提供代码，方法我知道，但不会写
怎么把图形中所有的标注删掉啊？
两个问题，切盼回复

misters 发表于 2005-6-2 18:22:00

这段程序是建立一个选择集，将标注对象加入选择集，把所有的标注都删除
当然，有更好的办法更好，请看一下下面的代码                       
       
        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 发表于 2005-6-3 08:27:00

非常感谢2楼的

wyj7485 发表于 2005-6-3 08:44:00

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

misters 发表于 2005-6-3 09:36:00

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

wyj7485 发表于 2005-6-3 10:16:00

你的这段就是啊:
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 发表于 2005-6-4 09:50:00

谢了，我试试

查看完整版本: 删除标注线和图层的问题