Select选择集应用一例

兰州人

采用功能函数实现选择集中对象的增加。

2. Function CreatSelectionSet(InputEntityObjectName As Variant) As AcadSelectionSet
3.   On Error Resume Next
4.   'Dim SSet As AcadSelectionSet
5.   If Not IsNull(ThisDrawing.SelectionSets.Item("SelectEntity")) Then
6.     Set CreatSelectionSet = ThisDrawing.SelectionSets.Item("SelectEntity")
7.     CreatSelectionSet.Delete
8.   End If
9.   Set CreatSelectionSet = ThisDrawing.SelectionSets.Add("SelectEntity")
10.   Pt1 = ThisDrawing.Utility.GetPoint(, "Input First Point")
11.   Pt2 = ThisDrawing.Utility.GetPoint(Pt1, "Input First Point")
12.   Dim gpCode(0) As Integer
13.   Dim dataValue(0) As Variant
14.   gpCode(0) = 0
15.   For ii = 0 To UBound(InputEntityObjectName)
16.     dataValue(ii) = InputEntityObjectName(ii)
17.   Next ii
18.   CreatSelectionSet.Select acSelectionSetWindow, Pt1, Pt2, gpCode, dataValue
19. End Function
20. Sub ReadTable()
21.   Dim SSet As AcadSelectionSet
22.   Dim InputEntityObjectName As Variant
23.   InputEntityObjectName = Array("Text")
24.   Set SSet = CreatSelectionSet(InputEntityObjectName)
25.   Dim Ent As AcadEntity
26.   For Each Ent In SSet
27.     Debug.Print Ent.ObjectName
28.   Next Ent
29. End Sub

Function CreatSelectionSet(InputEntityObjectName As Variant) As AcadSelectionSet   On Error Resume Next   'Dim SSet As AcadSelectionSet   If Not IsNull(ThisDrawing.SelectionSets.Item("SelectEntity")) Then     Set CreatSelectionSet = ThisDrawing.SelectionSets.Item("SelectEntity")     CreatSelectionSet.Delete   End If   Set CreatSelectionSet = ThisDrawing.SelectionSets.Add("SelectEntity")   Pt1 = ThisDrawing.Utility.GetPoint(, "Input First Point")   Pt2 = ThisDrawing.Utility.GetPoint(Pt1, "Input First Point")   Dim gpCode(0) As Integer   Dim dataValue(0) As Variant   gpCode(0) = 0   For ii = 0 To UBound(InputEntityObjectName)     dataValue(ii) = InputEntityObjectName(ii)   Next ii   CreatSelectionSet.Select acSelectionSetWindow, Pt1, Pt2, gpCode, dataValue End Function Sub ReadTable()   Dim SSet As AcadSelectionSet   Dim InputEntityObjectName As Variant   InputEntityObjectName = Array("Text")   Set SSet = CreatSelectionSet(InputEntityObjectName)   Dim Ent As AcadEntity   For Each Ent In SSet     Debug.Print Ent.ObjectName   Next Ent End Sub