pckite 发表于 2004-11-16 09:45:00

不愧是班主啊

mccad 发表于 2004-11-19 21:03:00

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

雪山飞狐_lzh 发表于 2004-11-20 09:25:00

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


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


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


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

mccad 发表于 2004-11-20 21:08:00

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

雪山飞狐_lzh 发表于 2004-11-23 13:31:00

那就改成这样吧


Public Sub AddItems(ByVal objs)<BR>'向选择集加入实体<BR>On Error Resume Next<BR>                       <BR>                       If IsArray(objs) Then<BR>                                                       oSel.AddItems objs<BR>                       ElseIf IsObject(objs) Then<BR>                                                       Dim ents(0) As AcadEntity<BR>                                                       Set ents(0) = objs<BR>                                                       oSel.AddItems ents<BR>                       End If<BR>                       <BR>End Sub


Public Sub RemoveItems(ByVal objs)<BR>'在选择集中移除实体<BR>On Error Resume Next<BR>                       <BR>                       If IsArray(objs) Then<BR>                                                       oSel.RemoveItems objs<BR>                       ElseIf IsObject(objs) Then<BR>                                                       Dim ents(0) As AcadEntity<BR>                                                       Set ents(0) = objs<BR>                                                       oSel.RemoveItems ents<BR>                       End If<BR>                       <BR>End Sub<BR>


我顺便把实用函数的BuildFilter加进来了，：）


Public Sub SetFilter(ParamArray Filter())<BR>'设置过滤器<BR>On Error Resume Next<BR>                       <BR>                       Dim i<BR>                       Dim n As Integer<BR>                       Dim nCount As Integer<BR>                       nCount = (UBound(Filter) + 1) / 2 - 1<BR>                       <BR>                       Dim ft() As Integer, fd()<BR>                       ReDim ft(nCount), fd(nCount)<BR>                       <BR>                       For i = 0 To nCount<BR>                                                       n = i * 2<BR>                                                       ft(i) = Filter(n)<BR>                                                       fd(i) = Filter(n + 1)<BR>                       Next i<BR>                       <BR>                       TlsFt = ft<BR>                       TlsFd = fd


End Sub<BR>

tiger8888 发表于 2004-11-24 13:02:00

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

liub1979 发表于 2004-11-26 20:38:00

good

mccad 发表于 2004-11-26 21:09:00

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

雪山飞狐_lzh 发表于 2004-11-26 22:36:00

可以这样：<BR>ss1.additems ss2.toarray


ss1.removeitems ss2.toarray

仍在江湖 发表于 2005-1-30 00:06:00

牛人,解决了选择集方面的大问题,太感谢了.
页: 1 [2] 3
查看完整版本: 一个选择集的增强类，刚写好，大家提提意见