两个选择集问题

cxf11991

我要创建两个选择集，但是有不能冲突，该怎么办？ 比如：先创建一个包含所有物体的大选择集
'安全创建选择集
On Error Resume Next
If Not IsNull(ThisDrawing.SelectionSets.Item("example")) Then
Set objselectionset = ThisDrawing.SelectionSets.Item("example")
objselectionset.Delete
End If
Set objselectionset = ThisDrawing.SelectionSets.Add("example") '选取物体
frmmain.Hide
ThisDrawing.Utility.Prompt "选择物体"
objselectionset.SelectOnScreen 再去创建一个包含在大选择集里的小选择集，
'安全创建选择集
On Error Resume Next
If Not IsNull(ThisDrawing.SelectionSets.Item("example1")) Then
Set objselectionset1 = ThisDrawing.SelectionSets.Item("example1")
objselectionset1.Delete
End If
Set objselectionset1 = ThisDrawing.SelectionSets.Add("example1")

'选取过滤直线
Dim ft(0) As Integer, fd(0)
ft(0) = 0: fd(0) = "Line"
ThisDrawing.Utility.Prompt "请选择作为边界的直线:"
objselectionset1.SelectOnScreen ft, fd 问题：这样子做，会不会两个选择集冲突 也就是说，大的选择集先把所有物体选到objselectionset里 而小的选择集又把其中的两条直线选到objselectionset1里，而又使这两条直线不在原来的 objselectionset里，我应该怎么去做？？？？？

cxf11991

为什么还没有人发表啊，哭死我了

gzy

要从objselectionset中移除（RemoveItems）其中的两条直线。

mccad

选择集不会冲突的。
可以使用RemoveItems 方法来减去部分对象。

cxf11991

意思我完全懂了，不过我还是不知道怎么编程啊



我自己写过，但还是有问题，


能不能简单的帮我写一下代码啊，谢谢

mccad

2. Public Function ssSubtract(selSet As AcadSelectionSet, subSet As AcadSelectionSet) As AcadSelectionSet
3.        Dim cnt As Long
4.        Dim i As Long
5.        cnt = subSet.Count
6.        Dim objArray() As AcadEntity
7.        ReDim objArray(cnt - 1)
8.        For i = 0 To cnt - 1
9.                Set objArray(i) = subSet(i)
10.        Next i
11.        selSet.RemoveItems objArray
12.        Set ssSubtract = selSet
13. End FunctionSub ssSubSample()
14.        On Error Resume Next
15.        Dim ss1 As AcadSelectionSet
16.        Dim ss2 As AcadSelectionSet
17.        Set ss1 = ThisDrawing.SelectionSets.Add("1")
18.        Set ss2 = ThisDrawing.SelectionSets.Add("2")
19.        ThisDrawing.Utility.Prompt vbCr & "选择对象："
20.        ss1.SelectOnScreen
21.        ThisDrawing.Utility.Prompt vbCr & "选择要减去的对象："
22.        ss2.SelectOnScreen
23.        Set ss1 = ssSubtract(ss1, ss2)
24.        ss1.Highlight True
25.        MsgBox "已经高亮显示减去后的对象选择集", , "明经通道VBA示例"
26.        ss1.Highlight False
27.        ss1.Delete
28.        ss2.Delete
29. End Sub

Public Function ssSubtract(selSet As AcadSelectionSet, subSet As AcadSelectionSet) As AcadSelectionSet        Dim cnt As Long        Dim i As Long        cnt = subSet.Count        Dim objArray() As AcadEntity        ReDim objArray(cnt - 1)        For i = 0 To cnt - 1                Set objArray(i) = subSet(i)        Next i        selSet.RemoveItems objArray        Set ssSubtract = selSet End FunctionSub ssSubSample()        On Error Resume Next        Dim ss1 As AcadSelectionSet        Dim ss2 As AcadSelectionSet        Set ss1 = ThisDrawing.SelectionSets.Add("1")        Set ss2 = ThisDrawing.SelectionSets.Add("2")        ThisDrawing.Utility.Prompt vbCr & "选择对象："        ss1.SelectOnScreen        ThisDrawing.Utility.Prompt vbCr & "选择要减去的对象："        ss2.SelectOnScreen        Set ss1 = ssSubtract(ss1, ss2)        ss1.Highlight True        MsgBox "已经高亮显示减去后的对象选择集", , "明经通道VBA示例"        ss1.Highlight False        ss1.Delete        ss2.Delete End Sub