[编程交流] 选择集属性

Option Explicit
Dim intCode(1)              As Integer
Dim varData(1)              As Variant
Dim elem                    As AcadEntity
Dim Array1                  As Variant
Dim aCount                  As Long
Dim RefNum                  As Long
Dim RefEdit() As String
Dim iNo As Integer
Dim TotalRef As Long
Dim x As Long
Dim PrefixArray() As String
Dim i As Long
Dim count As Long
Dim IsItThere As Boolean
Dim MyLayer As AcadLayer
Private Sub UserForm_Initialize()
'Gathers together all reference blocks
intCode(0) = 0: varData(0) = "Insert"
intCode(1) = 2: varData(1) = "REF1_50"
TotalRef = AllSS(intCode, varData)
ReDim RefEdit(0 To TotalRef, 0 To 6)
For Each elem In ThisDrawing.SelectionSets.Item("TempSSet")
       'Using IsItThere to eliminate duplicates from end result - This creates a new 2d array called prefixarray
       IsItThere = False
       Array1 = elem.GetAttributes
       RefEdit(x, 0) = (Array1(0).TextString)
       RefEdit(x, 1) = (Array1(1).TextString)
       RefEdit(x, 2) = (Array1(2).TextString)
       RefEdit(x, 3) = elem.Layer
       [color=red]'RefEdit(x,4) = layer of textstring0 within elem block[/color]
[color=red]       'RefEdit(x,5) = colour of textstring0 within elem block[/color]
Next elem
End Sub
Sub SSClear()
Dim SSS As AcadSelectionSets
  On Error Resume Next
  Set SSS = ThisDrawing.SelectionSets
     If SSS.count > 0 Then
        SSS.Item("TempSSet").Delete
     End If
End Sub
Function AllSS(Optional grpCode As Variant, Optional dataVal As Variant) As Integer
  Dim TempObjSS As AcadSelectionSet
  SSClear
  Set TempObjSS = ThisDrawing.SelectionSets.Add("TempSSet")
        'pick selection set
  If IsMissing(grpCode) Then
     TempObjSS.Select acSelectionSetAll
  Else
     TempObjSS.Select acSelectionSetAll, , , grpCode, dataVal
  End If
  AllSS = TempObjSS.count
End Function

 RefEdit(x, 4) = (Array1(0).Layer)
                                 RefEdit(x, 5) = (Array1(0).color)