[VBA函数]：建立一个选择集，空对象指针错误

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

雪山飞狐(lzh)

Sub tt()
On Error Resume Next
Dim ss As AcadSelectionSet
ThisDrawing.SelectionSets("TEST").Delete
Set ss = ThisDrawing.SelectionSets.Add("TEST")
Dim ft(0) As Integer, fd(0)
ft(0) = 0: fd(0) = "dim*"
ss.Select acSelectionSetAll, , , ft, fd
ss.Erase
ss.Delete
End Sub

misters

Dim ft(0) As Integer
    Dim fd(0) As Variant
   
    ft(0) = 0
'    ft(1) = 0
'    ft(2) = 0
'    ft(3) = 0
'    ft(4) = 0
'    ft(5) = 0
'    ft(6) = 0
'    ft(7) = 0
'    ft(8) = 0
'    ft(9) = 0
    fd(0) = "circle" ' fd(0) = "MText"
'    fd(1) = "Text"
'    fd(2) = "RadialDimension"
'    fd(3) = "3PointAngularDimension"
'    fd(4) = "RotatedDimension"
'    fd(5) = "AlignedDimension"
'    fd(6) = "OrdinateDimension"
'    fd(7) = "Fcf"
'    fd(8) = "Leader"
    ssetObj.Select acSelectionSetAll, , , ft, fd
'    ssetObj.Select acSelectionSetAll, , , ft, fd(1)
'    ssetObj.Select acSelectionSetAll, , , ft, fd(2)
'    ssetObj.Select acSelectionSetAll, , , ft, fd(3)
'    ssetObj.Select acSelectionSetAll, , , ft, fd(4)
'    ssetObj.Select acSelectionSetAll, , , ft, fd(5)
'    ssetObj.Select acSelectionSetAll, , , ft, fd(6)
'    ssetObj.Select acSelectionSetAll, , , ft, fd(7)
'    ssetObj.Select acSelectionSetAll, , , ft, fd(8)
'    ssetObj.Select acSelectionSetAll, , , ft, fd(9)
'
圆可以，标注线这类的怎么就不行呢？

雪山飞狐(lzh)

你没看我的代码么？

misters

看了，执行删除圆没问题，代码如下：
  Dim ft(0) As Integer
    Dim fd(0) As Variant  
    ft(0) = 0
    fd(0) = "circle"
    ssetObj.Select acSelectionSetAll, , , ft, fd
    ssetObj.Erase
    ssetObj.Delete
    ZoomAll

但是如果删除标注的话，执行完了，没有任何错误，但跟没执行一样，标注删不掉
代码如下：
  Dim ft(0) As Integer
    Dim fd(0) As Variant  
    ft(0) = 0
    fd(0) = "RadialDimension"       标注类型:半径标注
    ssetObj.Select acSelectionSetAll, , , ft, fd
    ssetObj.Erase
    ssetObj.Delete
    ZoomAll

我想把所有标注一次都放到数组中，才出现了3楼加注释的代码
难道是标注类型的表达方式写的有问题？

雪山飞狐(lzh)

fd(0) = "dim*"就是代表所有标注