Сортировка коллекции/Selection Set

Sub SortLinesByStartPoints()
     Dim oSset As AcadSelectionSet
     Dim oEnt As AcadEntity
     Dim oLine As AcadLine
     Dim stPt As Variant
     Dim endPt As Variant
     Dim sortedArr As Variant
     Dim i As Long
     Dim oColl As Collection
     Set oColl = New Collection

     On Error Resume Next
     If Not IsNull(ThisDrawing.SelectionSets.Item("$SortLines$")) Then
          Set oSset = ThisDrawing.SelectionSets.Item("$SortLines$")
          oSset.Delete
     End If
     Set oSset = ThisDrawing.SelectionSets.Add("$SortLines$")
     oSset.SelectOnScreen

     ReDim objArr(0 To oSset.Count - 1, 0 To 3) As Variant

     For Each oEnt In oSset
          If TypeOf oEnt Is AcadLine Then
               Set oLine = oEnt
               stPt = oLine.StartPoint
               objArr(i, 0) = oLine.ObjectID
               objArr(i, 1) = stPt(0): objArr(i, 2) = stPt(1): objArr(i, 3) = stPt(2)
               i = i + 1
          End If
     Next

     sortedArr = ColSort(objArr, 2)     '<--sort by second subitem
     sortedArr = ColSort(sortedArr, 3)     '<--sort by third subitem
     sortedArr = ColSort(sortedArr, 4)     '<--sort by fourth subitem

     With ThisDrawing
          For i = 0 To UBound(sortedArr, 1)
               oColl.Add .ObjectIdToObject(sortedArr(i, 0))
          Next
     End With
     ' < do something with collection of lines here > '
     oSset.Delete
     Set oSset = Nothing

End Sub
'~~~~~~~~~~~~~~~~Sort two-dimensional array~~~~~~~~~~~~'
' written by Fatty T.O.H. (c)2006 * all rights removed '
' SourceArr - two dimensional array                    '
' iPos - column number to sort by (starting from 1)    '
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Public Function ColSort(SourceArr As Variant, iPos As Integer) As Variant

     Dim Check As Boolean
     ReDim tmpArr(UBound(SourceArr, 2)) As Variant
     Dim iCount As Integer
     Dim jCount As Integer
     Dim nCount As Integer

     iPos = iPos - 1
     Check = False

     Do Until Check
          Check = True
          For iCount = LBound(SourceArr, 1) To UBound(SourceArr, 1) - 1
               If SourceArr(iCount, iPos) > SourceArr(iCount + 1, iPos) Then
                    For jCount = LBound(SourceArr, 2) To UBound(SourceArr, 2)
                         tmpArr(jCount) = SourceArr(iCount, jCount)
                         SourceArr(iCount, jCount) = SourceArr(iCount + 1, jCount)
                         SourceArr(iCount + 1, jCount) = tmpArr(jCount)
                         Check = False
                    Next
               End If
          Next
     Loop

     ColSort = SourceArr

End Function