一个选择集的增强类，刚写好，大家提提意见

pckite

不愧是班主啊

mccad

还有一个建议，我最讨厌ActiveX中，有时只需要一个对象，但去还要去建一个一个元素的数组来放这么一个对象，太烦了。
所以最好在添加对象到选择集中或从选择集中去除对象能够做到单个对象和多个对象兼容。

雪山飞狐_lzh

Add和AddItems函数，Remove和RemoveItems函数是处理这种情况的


老大的意思是不是把它们合并？


如果在.Net或C＋＋里有函数重载好办，


VBA里如果强行做在一起，我的感觉是不太好

mccad

记住这种操作在AutoCAD对象模型的某个方法是有用过，在Excel中用得比较多吧。
就象这样：

2. Sub ss()
3.        Dim SSet As AcadSelectionSet
4.        Set SSet = PickFirstSSet
5.        Dim pnt, ent As AcadEntity
6.        ThisDrawing.Utility.GetEntity ent, pnt
7.        AddItems SSet, ent
8.        SSet.Highlight True
9.        MsgBox "显示刚选择并添加新对象的选择集"
10.        SSet.Highlight False
11. End Sub
12. Function PickFirstSSet() As AcadSelectionSet
13.        On Error Resume Next
14.        ThisDrawing.SelectionSets("PICKFIRST").Delete
15.        Set PickFirstSSet = ThisDrawing.PickfirstSelectionSet
16.        If PickFirstSSet.Count = 0 Then PickFirstSSet.SelectOnScreen
17. End Function
18. [b]Sub AddItems(SSet As AcadSelectionSet, Entitys As Variant)
19.        If IsArray(Entitys) Then
20.                SSet.AddItems Entitys
21.        ElseIf IsObject(Entitys) Then
22.                Dim Entity(0) As AcadEntity
23.                Set Entity(0) = Entitys
24.                SSet.AddItems Entity
25.        End If
26. End Sub[/b]

Sub ss()        Dim SSet As AcadSelectionSet        Set SSet = PickFirstSSet        Dim pnt, ent As AcadEntity        ThisDrawing.Utility.GetEntity ent, pnt        AddItems SSet, ent        SSet.Highlight True        MsgBox "显示刚选择并添加新对象的选择集"        SSet.Highlight False End Sub Function PickFirstSSet() As AcadSelectionSet        On Error Resume Next        ThisDrawing.SelectionSets("PICKFIRST").Delete        Set PickFirstSSet = ThisDrawing.PickfirstSelectionSet        If PickFirstSSet.Count = 0 Then PickFirstSSet.SelectOnScreen End Function [b]Sub AddItems(SSet As AcadSelectionSet, Entitys As Variant)        If IsArray(Entitys) Then                SSet.AddItems Entitys        ElseIf IsObject(Entitys) Then                Dim Entity(0) As AcadEntity                Set Entity(0) = Entitys                SSet.AddItems Entity        End If End Sub[/b]

雪山飞狐_lzh

那就改成这样吧 Public Sub AddItems(ByVal objs)
'向选择集加入实体
On Error Resume Next

If IsArray(objs) Then
oSel.AddItems objs
ElseIf IsObject(objs) Then
Dim ents(0) As AcadEntity
Set ents(0) = objs
oSel.AddItems ents
End If

End Sub Public Sub RemoveItems(ByVal objs)
'在选择集中移除实体
On Error Resume Next

If IsArray(objs) Then
oSel.RemoveItems objs
ElseIf IsObject(objs) Then
Dim ents(0) As AcadEntity
Set ents(0) = objs
oSel.RemoveItems ents
End If

End Sub
我顺便把实用函数的BuildFilter加进来了，：） Public Sub SetFilter(ParamArray Filter())
'设置过滤器
On Error Resume Next

Dim i
Dim n As Integer
Dim nCount As Integer
nCount = (UBound(Filter) + 1) / 2 - 1

Dim ft() As Integer, fd()
ReDim ft(nCount), fd(nCount)

For i = 0 To nCount
n = i * 2
ft(i) = Filter(n)
fd(i) = Filter(n + 1)
Next i

TlsFt = ft
TlsFd = fd End Sub

tiger8888

两位真是高手，就这样说着说着，又解决了cad的一个麻烦

liub1979

good

mccad

再提个要求吧：
把选择集的并集和差集也写到AddItems和RemoveItems中吧。

雪山飞狐_lzh

可以这样：
ss1.additems ss2.toarray ss1.removeitems ss2.toarray

仍在江湖

牛人,解决了选择集方面的大问题,太感谢了.