[求助]关于选择集，请大侠帮忙阿

tiger8888

我创建选择集后，想删除选择集中的一个项目，所移去的项目仍然存在，只是不在选择集中。可试了几次都不行。


假设ssget为选择集，我先用ssget(0).delete删除第一个项目，我本以为选择集会重新排列，可当我下次用到ssget（0）时，程序就出错。


后来，我用ssget.removeitems的方法，可不知如何用阿。这个方法好像要知道要删除项目的名字，我又怎么知道项目的名字呢。


acad2004的帮助看了半天，也没什么帮助，请大侠帮我

王咣生

参考: Public Sub test()
Dim ssetObj As AcadSelectionSet
Set ssetObj = CreateSSet("Test")

Dim mode As Integer
mode = acSelectionSetAll

'选择所有实体
ssetObj.Select mode

MsgBox ssetObj.Count

'如果选择集不为空,移除第一个实体
If ssetObj.Count > 0 Then
Dim removeObjects(0) As AcadEntity
Set removeObjects(0) = ssetObj(0)
ssetObj.RemoveItems removeObjects

MsgBox ssetObj.Count
End If

ssetObj.Clear
ssetObj.Delete

End Sub
'---------------------------------------------------------------------
'
'[函数] 创建选择集, 返回选择集对象
'
'--------------------------------------------------------------------- Private Function CreateSSet(ByVal name As String) As AcadSelectionSet
On Error GoTo ERR_HANDLER

Dim ssetObj As AcadSelectionSet
Dim SSetColl As AcadSelectionSets
Set SSetColl = ThisDrawing.SelectionSets

Dim index As Integer
Dim found As Boolean

found = False For index = 0 To SSetColl.Count - 1
Set ssetObj = SSetColl.Item(index)
If StrComp(ssetObj.name, name, 1) = 0 Then
found = True
Exit For
End If
Next


If Not (found) Then
Set ssetObj = SSetColl.Add(name)
Else
ssetObj.Clear
' ssetObj.Delete
' Set ssetObj = SSetColl.Add(name)
End If

Set CreateSSet = ssetObj

Exit Function
ERR_HANDLER:
'-----------------------------------------------
' just print the error the the debug window.
Debug.Print "Error in sub CreateSSet: " & Err.Number & " -- "; Err.Description
Resume ERR_END

ERR_END:
End Function

tiger8888

版主真是谢谢你了，我弄了一晚上。看了你的帖子，才解决了问题，真心谢谢你。