删除标注线和图层的问题

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

谢了，我试试

删除标注线和图层的问题

发表回复

精选推荐