实体不重复排序

Sub ls()
  Dim xm1(), abc(), Gggg()
  Dim Ent As AcadEntity
  Dim AllEntityArray, AllEntityCount As Integer
  AllEntityCount = ThisDrawing.ModelSpace.Count
  ReDim AllEntityArray(AllEntityCount - 1)
  For ii = 0 To AllEntityCount - 1
    With ThisDrawing.ModelSpace.Item(ii)
      AllEntityArray(ii) = .ObjectName
    End With
  Next ii
  abc = NoRepeatArray(AllEntityArray) '不重复数组处理
  Gggg = Bubble_Sort(abc)
  For ii = 1 To UBound(Gggg) - 1
    Debug.Print Gggg(ii)
  Next ii
  Debug.Print
End Sub
Function Bubble_Sort(Ary)
   Dim aryUBound, i, j
   aryUBound = UBound(Ary)
   For i = 1 To aryUBound
     For j = i + 1 To aryUBound
       If Ary(i) > Ary(j) Then
         Swap Ary(i), Ary(j)
       End If
     Next
   Next
   Bubble_Sort = Ary
End Function
Function Swap(a, b)
   Dim tmp
   tmp = a
   a = b
   b = tmp
End FunctionFunction NoRepeatArray(xm)
    Dim Arr(), Temp() As String '声明变量
    Dim s%, r% '声明单值变量
    On Error Resume Next '启动一个错误处理程序
    
    r = 0 '初值
    s = UBound(xm) '最大下标
    For i = 0 To s '循环
        Temp = Filter(Arr, xm(i)) '搜索数组
        If UBound(Temp) = -1 Then '如果未找到
            r = r + 1 '序号，自增1
            ReDim Preserve Arr(1 To r) '定义动态数组大小
            Arr(r) = xm(i) '把姓名复制到数组Arr()中。
        End If
    Next
    NoRepeatArray = Arr
End Function