关于选择集里循环的问题，看《cad vba&vb.net开发》不明白啊，总是失败呢？
我用书里建的clsSelectionSet.cls类，试了试循环命令，怎么总提示Public Sub FilterSSet()
Dim sset As New clsSelectionSet
Dim Element AsAcadEntity '定义选择集中的元素对象
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 AsVariant 也不行。
想不明白啊！
求高手解答
吃饭回来接着等，等级低 ，不能直接上传，把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
你在该类里加个AcSel属性对应m_sset吧 For i=0 to sset.count-1
.....
next i 类还没学过，支持一下
页:
[1]