关于选择集里循环的问题，看《cad vba&vb.net开发》不明白啊，总是失败呢？

kangruoguxp

我用书里建的clsSelectionSet.cls类，试了试循环命令，怎么总提示
Public Sub FilterSSet()
    Dim sset As New clsSelectionSet
    Dim Element As  AcadEntity '定义选择集中的元素对象
    Dim i As Integer
    sset.Create "sset"
    sset.SelectOnScreen
    For Each Element In sset
    i = i + 1
   
    MsgBox "选择集中实体的数量为: " & i
    Next
    sset.Delete
   
End Sub
运行到“ For Each Element In sset"这行时，总提示”对象不支持该属性方法“
改成     Dim Element As  Variant       也不行。
想不明白啊！
求高手解答

kangruoguxp

吃饭回来接着等，等级低 ，不能直接上传，把clsSelectionSet.cls类模块代码贴出来了，希望有高手能给解释。




Option Explicit

Private m_sset As AcadSelectionSet      ' 选择集对象
Private m_name As String                ' 选择集的名称
Private m_fType() As Integer            ' 过滤器规则
Private m_fData() As Variant            ' 过滤器参数
Private m_bEnableFilter As Boolean      ' 是否启动过滤器
Private m_bHasFilter As Boolean         ' 是否有过滤器可用

' 创建选择集
Public Sub Create(ByVal name As String)
    Debug.Assert (m_sset Is Nothing)
    On Error Resume Next
   
    If Not IsNull(ThisDrawing.SelectionSets.Item(name)) Then
        Set m_sset = ThisDrawing.SelectionSets.Item(name)
        m_sset.Delete
    End If
    Set m_sset = ThisDrawing.SelectionSets.Add(name)
    m_name = name
End Sub

' 删除选择集
Public Sub Delete()
    Debug.Assert (Not m_sset Is Nothing)
   
    m_sset.Delete
    Set m_sset = Nothing
End Sub

' 添加一个实体
Public Sub AddEntity(ByVal ent As AcadEntity)
    Debug.Assert (Not m_sset Is Nothing)
   
    Dim objCollection(0) As AcadEntity
    Set objCollection(0) = ent
   
    m_sset.AddItems objCollection
End Sub

' 添加多个实体
Public Function AddEntitys(ByVal ents As Variant) As Boolean
    Debug.Assert (Not m_sset Is Nothing)
   
    If VarType(ents) <> vbArray + vbObject Then
        AddEntitys = False
        Exit Function
    End If
   
    Dim objCollection() As AcadEntity
    ReDim objCollection(UBound(ents))
   
    Dim i As Integer
    For i = 0 To UBound(ents)
        Set objCollection(i) = ents(i)
    Next i
   
    m_sset.AddItems objCollection
    AddEntitys = True
End Function

' 删除一个实体
Public Sub RemoveEntity(ByVal ent As AcadEntity)
    Debug.Assert (Not m_sset Is Nothing)

    Dim objCollection(0) As AcadEntity
    Set objCollection(0) = ent
   
    m_sset.RemoveItems objCollection
End Sub

' 删除多个实体
Public Function RemoveEntitys(ByVal ents As Variant) As Boolean
    Debug.Assert (Not m_sset Is Nothing)

    If VarType(ents) <> vbArray + vbObject Then
        RemoveEntitys = False
        Exit Function
    End If
   
    Dim objCollection() As AcadEntity
    ReDim objCollection(UBound(ents))
   
    Dim i As Integer
    For i = 0 To UBound(ents)
        Set objCollection(i) = ents(i)
    Next i
   
    m_sset.RemoveItems objCollection
    RemoveEntitys = True
End Function

' 导出为对象数组
Public Function ExportToEntArray() As Variant
    Debug.Assert (Not m_sset Is Nothing)
   
    Dim objCollection() As AcadEntity
    ReDim objCollection(sset.Count - 1)
   
    Dim i As Integer
    For i = 0 To sset.Count - 1
        Set objCollection(i) = sset.Item(i)
    Next i
   
    ExportToEntArray = objCollection
End Function

' 点选对象
Public Sub SelectAtPoint(ByVal point As Variant)
    Debug.Assert (VarType(point) = vbArray + vbDouble)
    Debug.Assert (UBound(point) = 2)
    Debug.Assert (Not m_sset Is Nothing)
   
    If m_bHasFilter And m_bEnableFilter Then
        m_sset.Select acSelectionSetCrossing, point, point, m_fType, m_fData
    Else
        m_sset.Select acSelectionSetCrossing, point, point
    End If
End Sub

' 多边形选择
Public Sub SelectByPolyon(ByVal poly As AcadLWPolyline, ByVal mode As AcSelect)
    Debug.Assert (Not m_sset Is Nothing)
   
    ' 将轻量多段线的坐标输入到点数组中
    Dim pointArrs() As Double
    ReDim pointArrs((UBound(poly.Coordinates) + 1) * 3 / 2 - 1)
   
    Dim i As Integer
    For i = 0 To ((UBound(poly.Coordinates) + 1) / 2 - 1)
        pointArrs(3 * i) = poly.Coordinates(2 * i)
        pointArrs(3 * i + 1) = poly.Coordinates(2 * i + 1)
        pointArrs(3 * i + 2) = 0
    Next i
   
    If m_bHasFilter And m_bEnableFilter Then
        m_sset.SelectByPolygon mode, pointArrs, m_fType, m_fData
    Else
        m_sset.SelectByPolygon mode, pointArrs
    End If
End Sub

' 在屏幕上选择实体
Public Sub SelectOnScreen()
    Debug.Assert (Not m_sset Is Nothing)
   
    If m_bHasFilter And m_bEnableFilter Then
        m_sset.SelectOnScreen m_fType, m_fData
    Else
        m_sset.SelectOnScreen
    End If
End Sub

' 其他选择方式
Public Sub SelectEntity(ByVal mode As AcSelect, Optional point1 As Variant = Empty, Optional point2 As Variant = Empty)
    Debug.Assert (Not m_sset Is Nothing)
   
    If m_bHasFilter And m_bEnableFilter Then
        m_sset.Select mode, point1, point2, m_fType, m_fData
    Else
        m_sset.Select mode, point1, point2
    End If
End Sub

' 创建选择过滤器
Public Sub SetFilter(ParamArray filter())
    Debug.Assert (UBound(filter) Mod 2 = 1)
   
    Dim Count As Integer
    Count = (UBound(filter) + 1) / 2
    ReDim m_fType(Count - 1)
    ReDim m_fData(Count - 1)
    m_bHasFilter = True
   
    Dim i As Integer
    For i = 0 To Count - 1
        m_fType(i) = filter(2 * i)
        m_fData(i) = filter(2 * i + 1)
    Next i
End Sub

' 是否启用选择过滤器
Public Sub EnableFilter(Optional bEnable As Boolean = True)
    m_bEnableFilter = bEnable
End Sub

' 获得选择集中的实体个数
Public Function Count() As Integer
    Debug.Assert (Not m_sset Is Nothing)

    Count = m_sset.Count
End Function

' 获得选择集中的实体集合
Public Function GetAcadSelectionSet() As AcadSelectionSet
    Debug.Assert (Not m_sset Is Nothing)

    Set GetAcadSelectionSet = m_sset
End Function

Private Sub Class_Initialize()
    Set m_sset = Nothing
    m_bHasFilter = False
    m_bEnableFilter = False
End Sub

Private Sub Class_Terminate()
   If Not m_sset Is Nothing Then
        m_sset.Delete
        Set m_sset = Nothing
    End If
End Sub

雪山飞狐_lzh

你在该类里加个AcSel属性对应m_sset吧

markc0826

For i=0 to sset.count-1
.....
next i

liuzpzp007

类还没学过，支持一下