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

删除标注线和图层的问题

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


                       Dim obj As AcadObject<BR>                       Dim acadDoc As Object<BR>        <BR>                       For Each obj In acadApp.ActiveDocument.ModelSpace<BR>                                                       obj.Layer = "0"<BR>                                                       If obj.ObjectName = "AcDbBlockReference" Then<BR>                                                                                       obj.Explode<BR>                                                       End If<BR>                       Next<BR>


首先把所有的对象都放到0层，把块都打碎


下面是删除图层


                       acadApp.ActiveDocument.ModelSpace.PurgeAll<BR>                       Dim layerobj As AcadLayer<BR>                       Dim str As String<BR>                       Dim i As Long<BR>                       <BR>                       For i = 0 To acadApp.ActiveDocument.Layers.Count<BR>                                                       str = acadApp.ActiveDocument.Layers(i).Name<BR>                                                       If str &lt;&gt; "0" Then acadApp.ActiveDocument.Layers(i).Delete<BR>                       Next<BR>


有好方法的请提供代码，方法我知道，但不会写


怎么把图形中所有的标注删掉啊？


两个问题，切盼回复

wyj7485 发表于 2005-6-2 18:08:00

For each layerobj       in acadApp.ActiveDocument.Layers<BR>                                                       If layerobj .name &lt;&gt; "0" Then layerobj .Delete<BR>Next

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

这段程序是建立一个选择集，将标注对象加入选择集，把所有的标注都删除


当然，有更好的办法更好，请看一下下面的代码                       


       


        Set ACADapp = GetObject(, "AutoCAD.Application")<BR>                       Set ACADdoc = ACADapp.ActiveDocument<BR>                       Dim ssetObj As AcadSelectionSet<BR>                       ACADapp.ActiveDocument.SelectionSets("TEST_SELECTIONSET").Delete<BR>                       Set ssetObj = ACADapp.ActiveDocument.SelectionSets.Add("TEST_SELECTIONSET")<BR>                       <BR>                       Dim i As Long<BR>                       Dim obj As AcadObject


                       i = 0<BR>                       For Each obj In ACADapp.ActiveDocument.ModelSpace                       '遍历工作区中的实体<BR>                                                       Select Case obj.EntityName<BR>                                                                                       Case "AcDbMText", "AcDbText", "AcDbRadialDimension", "AcDb3PointAngularDimension", "AcDbRotatedDimension", "AcDbAlignedDimension", "AcDbOrdinateDimension", "AcDbFcf", "AcDbLeader"<BR>                                                                                                                       i = i + 1<BR>                                                                                       Case Else<BR>                                                       End Select<BR>                       Next obj


                       MsgBox i<BR>                       ReDim ssobjs(0 To i) As AcadEntity


                       i = 0<BR>                       For Each obj In ACADapp.ActiveDocument.ModelSpace                       '遍历工作区中的实体<BR>                                                       Select Case obj.EntityName<BR>                                                                                       Case "AcDbMText", "AcDbText", "AcDbRadialDimension", "AcDb3PointAngularDimension", "AcDbRotatedDimension", "AcDbAlignedDimension", "AcDbOrdinateDimension", "AcDbFcf", "AcDbLeader"<BR>                                                                                                                       Set ssobjs(i) = ACADapp.ActiveDocument.ModelSpace.Item(i)<BR>                                                                                                                       i = i + 1<BR>                                                                                       Case Else<BR>                                                       End Select


                       Next obj<BR>                       MsgBox i<BR>                       <BR>                       ssetObj.AddItems ssobjs                                                                                                                                                       '这句老提示空对象指针,是怎么回事<BR>                       <BR>                       ssetObj.Erase<BR>

misters 发表于 2005-6-3 08:27:00

非常感谢2楼的

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

删出标注为什么要这样呢?


直接遍历工作区中的实体,删出标注就可以了啊!<BR><BR>

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

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

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

你的这段就是啊:


For Each obj In ACADapp.ActiveDocument.ModelSpace                       '遍历工作区中的实体<BR>                                                       Select Case obj.EntityName<BR>                                                                                       Case "AcDbMText", "AcDbText", "AcDbRadialDimension", "AcDb3PointAngularDimension", "AcDbRotatedDimension", "AcDbAlignedDimension", "AcDbOrdinateDimension", "AcDbFcf", "AcDbLeader"<BR>                                                                                                                       'Set ssobjs(i) = ACADapp.ActiveDocument.ModelSpace.Item(i)<BR>                                                                                obj.delete<BR>                                                                                       Case Else<BR>                                                       End Select


                       Next obj<BR>

misters 发表于 2005-6-4 09:50:00

谢了，我试试
页: [1]
查看完整版本: 删除标注线和图层的问题