multi dimensional array

[Alex]

Hi
Very simple question:How to sort multi dimensional array?
Can anybody help me?

Thanks

[aks]

On 22 Dec 2004 09:22:21 -0800, "Alex" <al_axl@yahoo.com> wrote:

Hi
Very simple question:How to sort multi dimensional array?
Can anybody help me?

Thanks

I don't think the AutoCAD regulars can see your post because you may
not have posted through Autodesk's guards. Anyway, here is sort
routine that sorts a two column array. It was brute force adapted
from a single column sorting routine. The col argument designates
which column to sort on. Depending on what you need to do (the number
of columns) , this may be a solution for you.

Sub QSort2(List() As Variant, Col As Integer)
' an extremely fast sort method!!
' Sorts an array using Quick Sort algorithm
' Adapted from "Visual Basic Developers Guide"
Dim i, j, B, k As Integer
Dim l As Integer, t As String, r As Integer, d As Integer
Dim t1 As String
Dim p(1 To 100) As Integer
Dim w(1 To 100) As Integer
On Error GoTo ErrExit
k = 1
p(k) = LBound(List, 2)
w(k) = UBound(List, 2)
l = 0 ' was 1
d = 1
r = UBound(List, 2)

Select Case Col
Case Is = 1
Do
toploop1:
If r - l < 9 Then GoTo bubsort1
i = l
j = r
While j > i
If UCase(List(0, i)) > UCase(List(0, j)) Then
t = List(0, j)
t1 = List(1, j)
List(0, j) = List(0, i)
List(1, j) = List(1, i)
List(0, i) = t
List(1, i) = t1
d = -d
End If
If d = -1 Then
j = j - 1
Else
i = i + 1
End If
Wend
j = j + 1
k = k + 1
If i - l < r - j Then
p(k) = j
w(k) = r
r = i
Else
p(k) = l
w(k) = i
l = j
End If
d = -d
GoTo toploop1
bubsort1:
If r - l > 0 Then
For i = l To r
B = i
For j = B + 1 To r
If UCase(List(0, j)) <= UCase(List(0, B)) Then B =
j
Next j
If i <> B Then
t = List(0, B)
t1 = List(1, B)
List(0, B) = List(0, i)
List(1, B) = List(1, i)
List(0, i) = t
List(1, i) = t1
End If
Next i
End If
l = p(k)
r = w(k)
k = k - 1
Loop Until k = 0

Case Is = 2

Do
toploop2:
If r - l < 9 Then GoTo bubsort2
i = l
j = r
While j > i
If UCase(List(1, i)) > UCase(List(1, j)) Then
t = List(0, j)
t1 = List(1, j)
List(0, j) = List(0, i)
List(1, j) = List(1, i)
List(0, i) = t
List(1, i) = t1
d = -d
End If
If d = -1 Then
j = j - 1
Else
i = i + 1
End If
Wend
j = j + 1
k = k + 1
If i - l < r - j Then
p(k) = j
w(k) = r
r = i
Else
p(k) = l
w(k) = i
l = j
End If
d = -d
GoTo toploop2
bubsort2:
If r - l > 0 Then
For i = l To r
B = i
For j = B + 1 To r
If UCase(List(1, j)) <= UCase(List(1, B)) Then B =
j
Next j
If i <> B Then
t = List(0, B)
t1 = List(1, B)
List(0, B) = List(0, i)
List(1, B) = List(1, i)
List(0, i) = t
List(1, i) = t1
End If
Next i
End If
l = p(k)
r = w(k)
k = k - 1
Loop Until k = 0

End Select

ErrExit:
On Error GoTo 0
End Sub


AKS

[Alex]

Thanks, that what I need.



aks wrote:

On 22 Dec 2004 09:22:21 -0800, "Alex" <al_axl@yahoo.com> wrote:

Hi
Very simple question:How to sort multi dimensional array?
Can anybody help me?

Thanks


I don't think the AutoCAD regulars can see your post because you may
not have posted through Autodesk's guards. Anyway, here is sort
routine that sorts a two column array. It was brute force adapted
from a single column sorting routine. The col argument designates
which column to sort on. Depending on what you need to do (the
number
of columns) , this may be a solution for you.

Sub QSort2(List() As Variant, Col As Integer)
' an extremely fast sort method!!
' Sorts an array using Quick Sort algorithm
' Adapted from "Visual Basic Developers Guide"
Dim i, j, B, k As Integer
Dim l As Integer, t As String, r As Integer, d As Integer
Dim t1 As String
Dim p(1 To 100) As Integer
Dim w(1 To 100) As Integer
On Error GoTo ErrExit
k = 1
p(k) = LBound(List, 2)
w(k) = UBound(List, 2)
l = 0 ' was 1
d = 1
r = UBound(List, 2)

Select Case Col
Case Is = 1
Do
toploop1:
If r - l < 9 Then GoTo bubsort1
i = l
j = r
While j > i
If UCase(List(0, i)) > UCase(List(0, j)) Then
t = List(0, j)
t1 = List(1, j)
List(0, j) = List(0, i)
List(1, j) = List(1, i)
List(0, i) = t
List(1, i) = t1
d = -d
End If
If d = -1 Then
j = j - 1
Else
i = i + 1
End If
Wend
j = j + 1
k = k + 1
If i - l < r - j Then
p(k) = j
w(k) = r
r = i
Else
p(k) = l
w(k) = i
l = j
End If
d = -d
GoTo toploop1
bubsort1:
If r - l > 0 Then
For i = l To r
B = i
For j = B + 1 To r
If UCase(List(0, j)) <= UCase(List(0, B)) Then B
=
j
Next j
If i <> B Then
t = List(0, B)
t1 = List(1, B)
List(0, B) = List(0, i)
List(1, B) = List(1, i)
List(0, i) = t
List(1, i) = t1
End If
Next i
End If
l = p(k)
r = w(k)
k = k - 1
Loop Until k = 0

Case Is = 2

Do
toploop2:
If r - l < 9 Then GoTo bubsort2
i = l
j = r
While j > i
If UCase(List(1, i)) > UCase(List(1, j)) Then
t = List(0, j)
t1 = List(1, j)
List(0, j) = List(0, i)
List(1, j) = List(1, i)
List(0, i) = t
List(1, i) = t1
d = -d
End If
If d = -1 Then
j = j - 1
Else
i = i + 1
End If
Wend
j = j + 1
k = k + 1
If i - l < r - j Then
p(k) = j
w(k) = r
r = i
Else
p(k) = l
w(k) = i
l = j
End If
d = -d
GoTo toploop2
bubsort2:
If r - l > 0 Then
For i = l To r
B = i
For j = B + 1 To r
If UCase(List(1, j)) <= UCase(List(1, B)) Then B
=
j
Next j
If i <> B Then
t = List(0, B)
t1 = List(1, B)
List(0, B) = List(0, i)
List(1, B) = List(1, i)
List(0, i) = t
List(1, i) = t1
End If
Next i
End If
l = p(k)
r = w(k)
k = k - 1
Loop Until k = 0

End Select

ErrExit:
On Error GoTo 0
End Sub


AKS