|
发表于 2004-10-18 23:03:00
|
显示全部楼层
给你一个创建选择集的函数: '---------------------------------------------------------------------
'
'[函数] 创建选择集, 返回选择集对象
'
'---------------------------------------------------------------------
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
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
调用方法:
Dim ssetObj1 As AcadSelectionSet
Set ssetObj1 = CreateSSet("MySet") |
|