topic Sort an array of text objects Asc by their X and Y insertion point values in VBA Forum

Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Mon, 19 Jun 2006 19:35:15 GMT

example of individual text objects on screen

1 2 3
4 5 6
7 8 9

User selects objects
(objects are place into a selection set, then object in selection set are
placed into an array)

array order might look like this:

2,4,7,8,0,1,5,3,6,9

how do I sort the array by the text objects X,Y insertionpoint values:

1,4,7,2,5,8,3,6,9 (outcome desired)

Thanks

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Tue, 20 Jun 2006 13:12:52 GMT

Sort the objects by the Y coordinates using any sort algorithm then sort them by the X coordinates using any stable sort algorithm.

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Tue, 20 Jun 2006 15:32:50 GMT

Yup, looks good on paper. I haven't figured out how to create/use the sort
algorithms yet.
I did find a good site with many Sorting algorithms here:
http://www.xtremevbtalk.com/showthread.php?t=78889
These might help anyone in the future researching sorting.
Dan

wrote in message news:5211988@discussion.autodesk.com...
Sort the objects by the Y coordinates using any sort algorithm then sort
them by the X coordinates using any stable sort algorithm.

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Tue, 20 Jun 2006 20:10:52 GMT

Do you need to sort the TextObjects or only the TextString.?How are you planing to sort them, X left or right and Y up or down? If possible what are you trying to accomplish?

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Tue, 20 Jun 2006 20:54:21 GMT

Not sure how to clarify more, I will try.

I need to sort Text Object in the following order:
Text X coordinate Ascending
then sort Text by Y coordinate Descending

start:
1 2 3
4 5 6
7 8 9

SSet order: 2,4,7,8,0,1,5,3,6,9
Sorted order:1,4,7,2,5,8,3,6,9

I just want the order to look like it reads. Text Top to bottom, then left
to right.

Thanks again,
Dan

Thanks
wrote in message news:5212822@discussion.autodesk.com...
Do you need to sort the TextObjects or only the TextString.?How are you
planing to sort them, X left or right and Y up or down? If possible what are
you trying to accomplish?

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Tue, 20 Jun 2006 21:33:17 GMT

[code]
Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
'filter data for TEXT
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData

Dim coll As New Collection
Dim min, max
Dim ent As AcadEntity
Dim i As Integer
'Iterate SS and add X of lower bound box point
'as collection item and handle of entity as key.
For i = 0 To SS.Count - 1
Set ent = SS(i)
ent.GetBoundingBox min, max
coll.Add min(0), ent.Handle
Next i

'call sort method by Christian d'Heureuse (www.source-code.biz)
'something lighter will do(bubblesort), this is first I found.
Set coll = SortCollection(coll)

'do the same for min Y points...

Call SSRemove("test")

End Sub

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub

' This routine uses the "heap sort" algorithm to sort a VB collection.
' It returns the sorted collection.
' Author: Christian d'Heureuse (www.source-code.biz)
Public Function SortCollection(ByVal c As Collection) As Collection
Dim n As Long: n = c.Count
If n = 0 Then Set SortCollection = New Collection: Exit Function
ReDim Index(0 To n - 1) As Long ' allocate index array
Dim i As Long, m As Long
For i = 0 To n - 1: Index(i) = i + 1: Next ' fill index array
For i = n \ 2 - 1 To 0 Step -1 ' generate ordered
heap
Heapify c, Index, i, n
Next
For m = n To 2 Step -1 ' sort the index array
Exchange Index, 0, m - 1 ' move highest element
to top
Heapify c, Index, 0, m - 1
Next
Dim c2 As New Collection
For i = 0 To n - 1: c2.Add c.Item(Index(i)): Next ' fill output
collection
Set SortCollection = c2
End Function

Private Sub Heapify(ByVal c As Collection, Index() As Long, ByVal i1 As
Long, ByVal n As Long)
' Heap order rule: a >= a[2*i+1] and a >= a[2*i+2]
Dim nDiv2 As Long: nDiv2 = n \ 2
Dim i As Long: i = i1
Do While i < nDiv2
Dim k As Long: k = 2 * i + 1
If k + 1 < n Then
If c.Item(Index(k)) < c.Item(Index(k + 1)) Then k = k + 1
End If
If c.Item(Index(i)) >= c.Item(Index(k)) Then Exit Do
Exchange Index, i, k
i = k
Loop
End Sub

Private Sub Exchange(Index() As Long, ByVal i As Long, ByVal j As Long)
Dim Temp As Long: Temp = Index(i)
Index(i) = Index(j)
Index(j) = Temp
End Sub
[/code]

"Dan" wrote in message
news:5212919@discussion.autodesk.com...
Not sure how to clarify more, I will try.

I need to sort Text Object in the following order:
Text X coordinate Ascending
then sort Text by Y coordinate Descending

start:
1 2 3
4 5 6
7 8 9

SSet order: 2,4,7,8,0,1,5,3,6,9
Sorted order:1,4,7,2,5,8,3,6,9

I just want the order to look like it reads. Text Top to bottom, then left
to right.

Thanks again,
Dan

Thanks
wrote in message news:5212822@discussion.autodesk.com...
Do you need to sort the TextObjects or only the TextString.?How are you
planing to sort them, X left or right and Y up or down? If possible what are
you trying to accomplish?

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Tue, 20 Jun 2006 21:40:29 GMT

you have a few lines with word wrap in there...
"Paul Richardson" wrote in message
news:5212951@discussion.autodesk.com...
[code]
Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
'filter data for TEXT
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData

Dim coll As New Collection
Dim min, max
Dim ent As AcadEntity
Dim i As Integer
'Iterate SS and add X of lower bound box point
'as collection item and handle of entity as key.
For i = 0 To SS.Count - 1
Set ent = SS(i)
ent.GetBoundingBox min, max
coll.Add min(0), ent.Handle
Next i

'call sort method by Christian d'Heureuse (www.source-code.biz)
'something lighter will do(bubblesort), this is first I found.
Set coll = SortCollection(coll)

'do the same for min Y points...

Call SSRemove("test")

End Sub

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub

' This routine uses the "heap sort" algorithm to sort a VB collection.
' It returns the sorted collection.
' Author: Christian d'Heureuse (www.source-code.biz)
Public Function SortCollection(ByVal c As Collection) As Collection
Dim n As Long: n = c.Count
If n = 0 Then Set SortCollection = New Collection: Exit Function
ReDim Index(0 To n - 1) As Long ' allocate index array
Dim i As Long, m As Long
For i = 0 To n - 1: Index(i) = i + 1: Next ' fill index array
For i = n \ 2 - 1 To 0 Step -1 ' generate ordered
heap
Heapify c, Index, i, n
Next
For m = n To 2 Step -1 ' sort the index array
Exchange Index, 0, m - 1 ' move highest element
to top
Heapify c, Index, 0, m - 1
Next
Dim c2 As New Collection
For i = 0 To n - 1: c2.Add c.Item(Index(i)): Next ' fill output
collection
Set SortCollection = c2
End Function

Private Sub Heapify(ByVal c As Collection, Index() As Long, ByVal i1 As
Long, ByVal n As Long)
' Heap order rule: a >= a[2*i+1] and a >= a[2*i+2]
Dim nDiv2 As Long: nDiv2 = n \ 2
Dim i As Long: i = i1
Do While i < nDiv2
Dim k As Long: k = 2 * i + 1
If k + 1 < n Then
If c.Item(Index(k)) < c.Item(Index(k + 1)) Then k = k + 1
End If
If c.Item(Index(i)) >= c.Item(Index(k)) Then Exit Do
Exchange Index, i, k
i = k
Loop
End Sub

Private Sub Exchange(Index() As Long, ByVal i As Long, ByVal j As Long)
Dim Temp As Long: Temp = Index(i)
Index(i) = Index(j)
Index(j) = Temp
End Sub
[/code]

"Dan" wrote in message
news:5212919@discussion.autodesk.com...
Not sure how to clarify more, I will try.

I need to sort Text Object in the following order:
Text X coordinate Ascending
then sort Text by Y coordinate Descending

start:
1 2 3
4 5 6
7 8 9

SSet order: 2,4,7,8,0,1,5,3,6,9
Sorted order:1,4,7,2,5,8,3,6,9

I just want the order to look like it reads. Text Top to bottom, then left
to right.

Thanks again,
Dan

Thanks
wrote in message news:5212822@discussion.autodesk.com...
Do you need to sort the TextObjects or only the TextString.?How are you
planing to sort them, X left or right and Y up or down? If possible what are
you trying to accomplish?

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Tue, 20 Jun 2006 22:14:08 GMT

Wow, this is complex! I am looking into it now...

"Paul Richardson" wrote in message
news:5212954@discussion.autodesk.com...
you have a few lines with word wrap in there...
"Paul Richardson" wrote in message
news:5212951@discussion.autodesk.com...
[code]
Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
'filter data for TEXT
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData

Dim coll As New Collection
Dim min, max
Dim ent As AcadEntity
Dim i As Integer
'Iterate SS and add X of lower bound box point
'as collection item and handle of entity as key.
For i = 0 To SS.Count - 1
Set ent = SS(i)
ent.GetBoundingBox min, max
coll.Add min(0), ent.Handle
Next i

'call sort method by Christian d'Heureuse (www.source-code.biz)
'something lighter will do(bubblesort), this is first I found.
Set coll = SortCollection(coll)

'do the same for min Y points...

Call SSRemove("test")

End Sub

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub

' This routine uses the "heap sort" algorithm to sort a VB collection.
' It returns the sorted collection.
' Author: Christian d'Heureuse (www.source-code.biz)
Public Function SortCollection(ByVal c As Collection) As Collection
Dim n As Long: n = c.Count
If n = 0 Then Set SortCollection = New Collection: Exit Function
ReDim Index(0 To n - 1) As Long ' allocate index array
Dim i As Long, m As Long
For i = 0 To n - 1: Index(i) = i + 1: Next ' fill index array
For i = n \ 2 - 1 To 0 Step -1 ' generate ordered
heap
Heapify c, Index, i, n
Next
For m = n To 2 Step -1 ' sort the index array
Exchange Index, 0, m - 1 ' move highest element
to top
Heapify c, Index, 0, m - 1
Next
Dim c2 As New Collection
For i = 0 To n - 1: c2.Add c.Item(Index(i)): Next ' fill output
collection
Set SortCollection = c2
End Function

Private Sub Heapify(ByVal c As Collection, Index() As Long, ByVal i1 As
Long, ByVal n As Long)
' Heap order rule: a >= a[2*i+1] and a >= a[2*i+2]
Dim nDiv2 As Long: nDiv2 = n \ 2
Dim i As Long: i = i1
Do While i < nDiv2
Dim k As Long: k = 2 * i + 1
If k + 1 < n Then
If c.Item(Index(k)) < c.Item(Index(k + 1)) Then k = k + 1
End If
If c.Item(Index(i)) >= c.Item(Index(k)) Then Exit Do
Exchange Index, i, k
i = k
Loop
End Sub

Private Sub Exchange(Index() As Long, ByVal i As Long, ByVal j As Long)
Dim Temp As Long: Temp = Index(i)
Index(i) = Index(j)
Index(j) = Temp
End Sub
[/code]

"Dan" wrote in message
news:5212919@discussion.autodesk.com...
Not sure how to clarify more, I will try.

I need to sort Text Object in the following order:
Text X coordinate Ascending
then sort Text by Y coordinate Descending

start:
1 2 3
4 5 6
7 8 9

SSet order: 2,4,7,8,0,1,5,3,6,9
Sorted order:1,4,7,2,5,8,3,6,9

I just want the order to look like it reads. Text Top to bottom, then left
to right.

Thanks again,
Dan

Thanks
wrote in message news:5212822@discussion.autodesk.com...
Do you need to sort the TextObjects or only the TextString.?How are you
planing to sort them, X left or right and Y up or down? If possible what are
you trying to accomplish?

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Tue, 20 Jun 2006 22:23:24 GMT

This is what I have so far. I am attaching a sample drawing to help make my
intentions clear. Thank you all so much. This is indeed more challenging
than I originally thought.

[code]
Option Explicit
Sub FieldsToTableFinal()
Dim oSsets As AcadSelectionSets
Dim oSset As AcadSelectionSet
Dim oTable As AcadTable
Dim oText As AcadText
Dim j, k, l, m As Long
Dim i, n As Integer
Dim ftype(0) As Integer
Dim fData(0) As Variant
Dim insPt As Variant
Dim tmpStr As String
Dim basePnt As Variant
Dim celltxtchk As String
Dim oMText As AcadMText
Dim SSetSort As Variant

ftype(0) = 0: fData(0) = "TEXT"
On Error Resume Next
ThisDrawing.SelectionSets.Item("FieldsToTable").Delete
Set oSset = ThisDrawing.SelectionSets.Add("FieldsToTable")
On Error GoTo ErrMsg
oSset.SelectOnScreen 'I need to figure out filtering for moth Text &
mText

'I am stuck on this section
For i = 0 To oSset.Count - 1
Set SSetSort(i) = oSset.Item(i)
'
'SORT Code here?
'
'I need to figure out how to resort this array, and place the
correct order
'back into a SS to use
Next

i = oSset.Count
ThisDrawing.Utility.GetEntity oTable, basePnt, "Select Table to
fill-out:"
k = oTable.Columns
If k <> 2 And k <> 5 Then
Exit Sub
End If
j = i \ k
l = 0
n = 0
For l = 0 To k - 1
For m = 3 To j + 2
celltxtchk = oSset.Item(n).ObjectName
If celltxtchk = "AcDbMText" Then
Set oMText = oSset.Item(n)
MsgBox oMText.TextString
MsgBox oMText.InsertionPoint(1)
tmpStr = CStr(oMText.ObjectID)
End If
If celltxtchk = "AcDbText" Then
Set oText = oSset.Item(n)
MsgBox oText.TextString
MsgBox oText.InsertionPoint(1)
tmpStr = CStr(oText.ObjectID)
End If
tmpStr = "%<\AcObjProp Object(%<\_ObjId " & tmpStr & _
">%).TextString \f " & "" & "%bl2" & "" & ">%"
oTable.SetText m, l, tmpStr
n = n + 1
oTable.Update
Next
Next

oSset.Clear
oSset.Delete
Set oSset = Nothing
Set oSsets = Nothing
Set oTable = Nothing
Exit Sub

ErrMsg:
MsgBox Err.Description

End Sub
[/code]

Dan

"Dan" wrote in message
news:5212989@discussion.autodesk.com...
Wow, this is complex! I am looking into it now...

"Paul Richardson" wrote in message
news:5212954@discussion.autodesk.com...
you have a few lines with word wrap in there...
"Paul Richardson" wrote in message
news:5212951@discussion.autodesk.com...
[code]
Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
'filter data for TEXT
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData

Dim coll As New Collection
Dim min, max
Dim ent As AcadEntity
Dim i As Integer
'Iterate SS and add X of lower bound box point
'as collection item and handle of entity as key.
For i = 0 To SS.Count - 1
Set ent = SS(i)
ent.GetBoundingBox min, max
coll.Add min(0), ent.Handle
Next i

'call sort method by Christian d'Heureuse (www.source-code.biz)
'something lighter will do(bubblesort), this is first I found.
Set coll = SortCollection(coll)

'do the same for min Y points...

Call SSRemove("test")

End Sub

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub

' This routine uses the "heap sort" algorithm to sort a VB collection.
' It returns the sorted collection.
' Author: Christian d'Heureuse (www.source-code.biz)
Public Function SortCollection(ByVal c As Collection) As Collection
Dim n As Long: n = c.Count
If n = 0 Then Set SortCollection = New Collection: Exit Function
ReDim Index(0 To n - 1) As Long ' allocate index array
Dim i As Long, m As Long
For i = 0 To n - 1: Index(i) = i + 1: Next ' fill index array
For i = n \ 2 - 1 To 0 Step -1 ' generate ordered
heap
Heapify c, Index, i, n
Next
For m = n To 2 Step -1 ' sort the index array
Exchange Index, 0, m - 1 ' move highest element
to top
Heapify c, Index, 0, m - 1
Next
Dim c2 As New Collection
For i = 0 To n - 1: c2.Add c.Item(Index(i)): Next ' fill output
collection
Set SortCollection = c2
End Function

Private Sub Heapify(ByVal c As Collection, Index() As Long, ByVal i1 As
Long, ByVal n As Long)
' Heap order rule: a >= a[2*i+1] and a >= a[2*i+2]
Dim nDiv2 As Long: nDiv2 = n \ 2
Dim i As Long: i = i1
Do While i < nDiv2
Dim k As Long: k = 2 * i + 1
If k + 1 < n Then
If c.Item(Index(k)) < c.Item(Index(k + 1)) Then k = k + 1
End If
If c.Item(Index(i)) >= c.Item(Index(k)) Then Exit Do
Exchange Index, i, k
i = k
Loop
End Sub

Private Sub Exchange(Index() As Long, ByVal i As Long, ByVal j As Long)
Dim Temp As Long: Temp = Index(i)
Index(i) = Index(j)
Index(j) = Temp
End Sub
[/code]

"Dan" wrote in message
news:5212919@discussion.autodesk.com...
Not sure how to clarify more, I will try.

I need to sort Text Object in the following order:
Text X coordinate Ascending
then sort Text by Y coordinate Descending

start:
1 2 3
4 5 6
7 8 9

SSet order: 2,4,7,8,0,1,5,3,6,9
Sorted order:1,4,7,2,5,8,3,6,9

I just want the order to look like it reads. Text Top to bottom, then left
to right.

Thanks again,
Dan

Thanks
wrote in message news:5212822@discussion.autodesk.com...
Do you need to sort the TextObjects or only the TextString.?How are you
planing to sort them, X left or right and Y up or down? If possible what are
you trying to accomplish?

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Tue, 20 Jun 2006 22:27:42 GMT

a Dictionary will work better...I'll write it up hold on.
"Dan" wrote in message
news:5213035@discussion.autodesk.com...
This is what I have so far. I am attaching a sample drawing to help make my
intentions clear. Thank you all so much. This is indeed more challenging
than I originally thought.

[code]
Option Explicit
Sub FieldsToTableFinal()
Dim oSsets As AcadSelectionSets
Dim oSset As AcadSelectionSet
Dim oTable As AcadTable
Dim oText As AcadText
Dim j, k, l, m As Long
Dim i, n As Integer
Dim ftype(0) As Integer
Dim fData(0) As Variant
Dim insPt As Variant
Dim tmpStr As String
Dim basePnt A
s Variant
Dim celltxtchk As String
Dim oMText As AcadMText
Dim SSetSort As Variant

ftype(0) = 0: fData(0) = "TEXT"
On Error Resume Next
ThisDrawing.SelectionSets.Item("FieldsToTable").Delete
Set oSset = ThisDrawing.SelectionSets.Add("FieldsToTable")
On Error GoTo ErrMsg
oSset.SelectOnScreen 'I need to figure out filtering for moth Text &
mText

'I am stuck on this section
For i = 0 To oSset.Count - 1
Set SSetSort(i) = oSset.Item(i)

'
'SORT Code here?
'
'I need to figure out how to resort this array, and place the
correct order
'back into a SS to use
Next

i = oSset.Count
ThisDrawing.Utility.GetEntity oTable, basePnt, "Select Table to
fill-out:"
k = oTable.Columns
If k <> 2 And k <> 5 Then
Exit Sub
End If
j = i \ k
l = 0
n = 0
For l = 0 To k - 1
For m = 3 To j + 2
celltxtchk = oSset.Item(n)
ObjectName
If celltxtchk = "AcDbMText" Then
Set oMText = oSset.Item(n)
MsgBox oMText.TextString
MsgBox oMText.InsertionPoint(1)
tmpStr = CStr(oMText.ObjectID)
End If
If celltxtchk = "AcDbText" Then
Set oText = oSset.Item(n)
MsgBox oText.TextString
MsgBox oText.InsertionPoint(1)
tmpStr = CStr(oText.ObjectID)

End If
tmpStr = "%<\AcObjProp Object(%<\_ObjId " & tmpStr & _
">%).TextString \f " & "" & "%bl2" & "" & ">%"
oTable.SetText m, l, tmpStr
n = n + 1
oTable.Update
Next
Next

oSset.Clear
oSset.Delete
Set oSset = Nothing
Set oSsets = Nothing
Set oTable = Nothing
Exit Sub

ErrMsg:
MsgBox Err.Description

End Sub
[/code]

Dan

"Dan" wrote
in message
news:5212989@discussion.autodesk.com...
Wow, this is complex! I am looking into it now...

"Paul Richardson" wrote in message
news:5212954@discussion.autodesk.com...
you have a few lines with word wrap in there...
"Paul Richardson" wrote in message
news:5212951@discussion.autodesk.com...
[code]
Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
'filter data for TEXT
filType(0) = 0

filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData

Dim coll As New Collection
Dim min, max
Dim ent As AcadEntity
Dim i As Integer
'Iterate SS and add X of lower bound box point
'as collection item and handle of entity as key.
For i = 0 To SS.Count - 1
Set ent = SS(i)
ent.GetBoundingBox min, max
coll.Add min(0), ent.Handle
Next i

'call sort method by Christian d'Heureuse (www.source-code.biz)
'something lighter w
ill do(bubblesort), this is first I found.
Set coll = SortCollection(coll)

'do the same for min Y points...

Call SSRemove("test")

End Sub

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub

' This routine uses the "heap sor
t" algorithm to sort a VB collection.
' It returns the sorted collection.
' Author: Christian d'Heureuse (www.source-code.biz)
Public Function SortCollection(ByVal c As Collection) As Collection
Dim n As Long: n = c.Count
If n = 0 Then Set SortCollection = New Collection: Exit Function
ReDim Index(0 To n - 1) As Long ' allocate index array
Dim i As Long, m As Long
For i = 0 To n - 1: Index(i) = i + 1: Next ' fill index array
For i = n
\ 2 - 1 To 0 Step -1 ' generate ordered
heap
Heapify c, Index, i, n
Next
For m = n To 2 Step -1 ' sort the index array
Exchange Index, 0, m - 1 ' move highest element
to top
Heapify c, Index, 0, m - 1
Next
Dim c2 As New Collection
For i = 0 To n - 1: c2.Add c.Item(Index(i)): Next ' fill output
collection
Set SortCollection = c2
End Function

Private Sub Heapify(B
yVal c As Collection, Index() As Long, ByVal i1 As
Long, ByVal n As Long)
' Heap order rule: a >= a[2*i+1] and a >= a[2*i+2]
Dim nDiv2 As Long: nDiv2 = n \ 2
Dim i As Long: i = i1
Do While i < nDiv2
Dim k As Long: k = 2 * i + 1
If k + 1 < n Then
If c.Item(Index(k)) < c.Item(Index(k + 1)) Then k = k + 1
End If
If c.Item(Index(i)) >= c.Item(Index(k)) Then Exit Do
Exchange Index, i, k
i = k
Loop
End Sub

P
rivate Sub Exchange(Index() As Long, ByVal i As Long, ByVal j As Long)
Dim Temp As Long: Temp = Index(i)
Index(i) = Index(j)
Index(j) = Temp
End Sub
[/code]

"Dan" wrote in message
news:5212919@discussion.autodesk.com...
Not sure how to clarify more, I will try.

I need to sort Text Object in the following order:
Text X coordinate Ascending
then sort Text by Y coordinate Descending

start:
1 2 3
4 5 6
7 8 9

SSet or
der: 2,4,7,8,0,1,5,3,6,9
Sorted order:1,4,7,2,5,8,3,6,9

I just want the order to look like it reads. Text Top to bottom, then left
to right.

Thanks again,
Dan

Thanks
wrote in message news:5212822@discussion.autodesk.com...
Do you need to sort the TextObjects or only the TextString.?How are you
planing to sort them, X left or right and Y up or down? If possible what are
you trying to accomplish?

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Tue, 20 Jun 2006 22:35:24 GMT

I really do not understand most of what is happening in the heap sort
method, but I will learn it. I appreciate all the help. This code is much
more advanced than I have ever written. I was hoping to learn some new
tricks, but found a whole new area of coding I can explore.

Thanks again,
Dan

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Tue, 20 Jun 2006 23:55:35 GMT

The nice thing is you don't have to know what is going in the sort
methods, just that it returns a sorted something for now...

That being said, here is code to add the x and y insertion coords to a 2d
array,
and then relate a sorted 2d array of insertion points back to entities in
your selection set.

You need a function to sort 2d arrays...google "Sort 2d coordinates" or such

[code]
Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
'filter data for TEXT
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData
'create 2d array (x,y) same size as your SS
ReDim coords(SS.Count - 1, 1)

Dim txtEnt As AcadText
Dim i As Integer

For i = 0 To SS.Count - 1
Set txtEnt = SS(i)
coords(i, 0) = txtEnt.InsertionPoint(0)
coords(i, 1) = txtEnt.InsertionPoint(1)
Next i

'now you have an array of 2d coordinates, do
'a google for a function that will sort 2d
'coordinate arrays.

Dim j As Integer
'relate sorted coords back to your SS ents
'doesn't consider duplicate insertion points
For i = LBound(coords) To UBound(coords)
For j = 0 To SS.Count - 1
Set txtEnt = SS(j)
If txtEnt.InsertionPoint(0) = coords(i, 0) And _
txtEnt.InsertionPoint(1) = coords(i, 1) Then
'add text value to your table
Exit For
End If
Next j
Next i

Call SSRemove("test")

End Sub

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub
[/code]

"Dan" wrote in message
news:5213024@discussion.autodesk.com...
I really do not understand most of what is happening in the heap sort
method, but I will learn it. I appreciate all the help. This code is much
more advanced than I have ever written. I was hoping to learn some new
tricks, but found a whole new area of coding I can explore.

Thanks again,
Dan

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Wed, 21 Jun 2006 00:07:49 GMT

Thank you so much. I will attemp to incorporate this new code and
information into my routine.
Thanks again for all your help. When complete, this will save a tremendous
amount of rework.

Dan

"Paul Richardson" wrote in message
news:5213115@discussion.autodesk.com...
The nice thing is you don't have to know what is going in the sort
methods, just that it returns a sorted something for now...

That being said, here is code to add the x and y insertion coords to a 2d
array,
and then relate a sorted 2d array of insertion points back to entities in
your selection set.

You need a function to sort 2d arrays...google "Sort 2d coordinates" or such

[code]
Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
'filter data for TEXT
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData
'create 2d array (x,y) same size as your SS
ReDim coords(SS.Count - 1, 1)

Dim txtEnt As AcadText
Dim i As Integer

For i = 0 To SS.Count - 1
Set txtEnt = SS(i)
coords(i, 0) = txtEnt.InsertionPoint(0)
coords(i, 1) = txtEnt.InsertionPoint(1)
Next i

'now you have an array of 2d coordinates, do
'a google for a function that will sort 2d
'coordinate arrays.

Dim j As Integer
'relate sorted coords back to your SS ents
'doesn't consider duplicate insertion points
For i = LBound(coords) To UBound(coords)
For j = 0 To SS.Count - 1
Set txtEnt = SS(j)
If txtEnt.InsertionPoint(0) = coords(i, 0) And _
txtEnt.InsertionPoint(1) = coords(i, 1) Then
'add text value to your table
Exit For
End If
Next j
Next i

Call SSRemove("test")

End Sub

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub
[/code]

"Dan" wrote in message
news:5213024@discussion.autodesk.com...
I really do not understand most of what is happening in the heap sort
method, but I will learn it. I appreciate all the help. This code is much
more advanced than I have ever written. I was hoping to learn some new
tricks, but found a whole new area of coding I can explore.

Thanks again,
Dan

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Wed, 21 Jun 2006 03:26:49 GMT

Here ya go...Very simple I just subtracted the Y insertion
point from the X insertion point and used the difference to
sort.

[code]
Option Explicit
Const dictKey = 1
Const dictItem = 2

Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData

Dim Dict As Scripting.Dictionary
Set Dict = SSToDictionary(SS)
SortDictionary Dict, dictItem

'iterate sorted collection use Dict.Key to get
'the ents.
Dim i As Integer
Dim txt As AcadText
For i = 0 To Dict.Count - 1
Set txt = ThisDrawing.HandleToObject(Dict.Keys(i))
txt.TextString = i 'test only remove
'add to your table
Next i

Call SSRemove("test")

End Sub

'Add ss ents to Dictionary using ent.handle as key and ents
'(xIns - yIns) as item.
Function SSToDictionary(inSS As AcadSelectionSet) As Scripting.Dictionary
Dim i As Integer

Dim txt As AcadText
Dim Dict As New Scripting.Dictionary

For i = 0 To inSS.Count - 1
Set txt = inSS(i)
Dict.Add txt.Handle, _
(VBA.Round((CStr(txt.InsertionPoint(0) - txt.InsertionPoint(1))), 2))
Next i

Set SSToDictionary = Dict

End Function

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub

'Modified MSDN Function
Function SortDictionary(objDict, intSort)
' declare our variables
Dim Dict()
Dim objKey
Dim strKey, strItem
Dim X, Y, Z

' get the dictionary count
Z = objDict.Count

' we need more than one item to warrant sorting
If Z > 1 Then
' create an array to store dictionary information
ReDim Dict(Z, 2)
X = 0
' populate the array
For Each objKey In objDict
Dict(X, dictKey) = (objKey)
Dict(X, dictItem) = (objDict(objKey))
X = X + 1
Next

' perform a a shell sort of the string array
For X = 0 To (Z - 2)
For Y = X To (Z - 1)
If Dict(X, intSort) > Dict(Y, intSort) Then
strKey = Dict(X, dictKey)
strItem = Dict(X, dictItem)
Dict(X, dictKey) = Dict(Y, dictKey)
Dict(X, dictItem) = Dict(Y, dictItem)
Dict(Y, dictKey) = strKey
Dict(Y, dictItem) = strItem
End If
Next
Next

' erase the contents of the dictionary object
objDict.RemoveAll

' repopulate the dictionary with the sorted information
For X = 0 To (Z - 1)
objDict.Add Dict(X, dictKey), Dict(X, dictItem)
Next

End If

End Function
[/code]

"Dan" wrote in message
news:5213107@discussion.autodesk.com...
Thank you so much. I will attemp to incorporate this new code and
information into my routine.
Thanks again for all your help. When complete, this will save a tremendous
amount of rework.

Dan

"Paul Richardson" wrote in message
news:5213115@discussion.autodesk.com...
The nice thing is you don't have to know what is going in the sort
methods, just that it returns a sorted something for now...

That being said, here is code to add the x and y insertion coords to a 2d
array,
and then relate a sorted 2d array of insertion points back to entities in
your selection set.

You need a function to sort 2d arrays...google "Sort 2d coordinates" or such

[code]
Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
'filter data for TEXT
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData
'create 2d array (x,y) same size as your SS
ReDim coords(SS.Count - 1, 1)

Dim txtEnt As AcadText
Dim i As Integer

For i = 0 To SS.Count - 1
Set txtEnt = SS(i)
coords(i, 0) = txtEnt.InsertionPoint(0)
coords(i, 1) = txtEnt.InsertionPoint(1)
Next i

'now you have an array of 2d coordinates, do
'a google for a function that will sort 2d
'coordinate arrays.

Dim j As Integer
'relate sorted coords back to your SS ents
'doesn't consider duplicate insertion points
For i = LBound(coords) To UBound(coords)
For j = 0 To SS.Count - 1
Set txtEnt = SS(j)
If txtEnt.InsertionPoint(0) = coords(i, 0) And _
txtEnt.InsertionPoint(1) = coords(i, 1) Then
'add text value to your table
Exit For
End If
Next j
Next i

Call SSRemove("test")

End Sub

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub
[/code]

"Dan" wrote in message
news:5213024@discussion.autodesk.com...
I really do not understand most of what is happening in the heap sort
method, but I will learn it. I appreciate all the help. This code is much
more advanced than I have ever written. I was hoping to learn some new
tricks, but found a whole new area of coding I can explore.

Thanks again,
Dan

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Wed, 21 Jun 2006 03:44:55 GMT

you need to reference the "microsoft scripting runtime" but the
idea doesn't work anyway...I should have tired it first..

"Paul Richardson" wrote in message
news:5213225@discussion.autodesk.com...
Here ya go...Very simple I just subtracted the Y insertion
point from the X insertion point and used the difference to
sort.

[code]
Option Explicit
Const dictKey = 1
Const dictItem = 2

Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData

Dim Dict As Scripting.Dictionary
Set Dict = SSToDictionary(SS)
SortDictionary Dict, dictItem

'iterate sorted collection use Dict.Key to get
'the ents.
Dim i As Integer
Dim txt As AcadText
For i = 0 To Dict.Count - 1
Set txt = ThisDrawing.HandleToObject(Dict.Keys(i))
txt.TextString = i 'test only remove
'add to your table
Next i

Call SSRemove("test")

End Sub

'Add ss ents to Dictionary using ent.handle as key and ents
'(xIns - yIns) as item.
Function SSToDictionary(inSS As AcadSelectionSet) As Scripting.Dictionary
Dim i As Integer

Dim txt As AcadText
Dim Dict As New Scripting.Dictionary

For i = 0 To inSS.Count - 1
Set txt = inSS(i)
Dict.Add txt.Handle, _
(VBA.Round((CStr(txt.InsertionPoint(0) - txt.InsertionPoint(1))), 2))
Next i

Set SSToDictionary = Dict

End Function

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub

'Modified MSDN Function
Function SortDictionary(objDict, intSort)
' declare our variables
Dim Dict()
Dim objKey
Dim strKey, strItem
Dim X, Y, Z

' get the dictionary count
Z = objDict.Count

' we need more than one item to warrant sorting
If Z > 1 Then
' create an array to store dictionary information
ReDim Dict(Z, 2)
X = 0
' populate the array
For Each objKey In objDict
Dict(X, dictKey) = (objKey)
Dict(X, dictItem) = (objDict(objKey))
X = X + 1
Next

' perform a a shell sort of the string array
For X = 0 To (Z - 2)
For Y = X To (Z - 1)
If Dict(X, intSort) > Dict(Y, intSort) Then
strKey = Dict(X, dictKey)
strItem = Dict(X, dictItem)
Dict(X, dictKey) = Dict(Y, dictKey)
Dict(X, dictItem) = Dict(Y, dictItem)
Dict(Y, dictKey) = strKey
Dict(Y, dictItem) = strItem
End If
Next
Next

' erase the contents of the dictionary object
objDict.RemoveAll

' repopulate the dictionary with the sorted information
For X = 0 To (Z - 1)
objDict.Add Dict(X, dictKey), Dict(X, dictItem)
Next

End If

End Function
[/code]

"Dan" wrote in message
news:5213107@discussion.autodesk.com...
Thank you so much. I will attemp to incorporate this new code and
information into my routine.
Thanks again for all your help. When complete, this will save a tremendous
amount of rework.

Dan

"Paul Richardson" wrote in message
news:5213115@discussion.autodesk.com...
The nice thing is you don't have to know what is going in the sort
methods, just that it returns a sorted something for now...

That being said, here is code to add the x and y insertion coords to a 2d
array,
and then relate a sorted 2d array of insertion points back to entities in
your selection set.

You need a function to sort 2d arrays...google "Sort 2d coordinates" or such

[code]
Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
'filter data for TEXT
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData
'create 2d array (x,y) same size as your SS
ReDim coords(SS.Count - 1, 1)

Dim txtEnt As AcadText
Dim i As Integer

For i = 0 To SS.Count - 1
Set txtEnt = SS(i)
coords(i, 0) = txtEnt.InsertionPoint(0)
coords(i, 1) = txtEnt.InsertionPoint(1)
Next i

'now you have an array of 2d coordinates, do
'a google for a function that will sort 2d
'coordinate arrays.

Dim j As Integer
'relate sorted coords back to your SS ents
'doesn't consider duplicate insertion points
For i = LBound(coords) To UBound(coords)
For j = 0 To SS.Count - 1
Set txtEnt = SS(j)
If txtEnt.InsertionPoint(0) = coords(i, 0) And _
txtEnt.InsertionPoint(1) = coords(i, 1) Then
'add text value to your table
Exit For
End If
Next j
Next i

Call SSRemove("test")

End Sub

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub
[/code]

"Dan" wrote in message
news:5213024@discussion.autodesk.com...
I really do not understand most of what is happening in the heap sort
method, but I will learn it. I appreciate all the help. This code is much
more advanced than I have ever written. I was hoping to learn some new
tricks, but found a whole new area of coding I can explore.

Thanks again,
Dan

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Wed, 21 Jun 2006 11:53:07 GMT

check out this link, it's in c but should give you
some ideas...
http://www.cedarcreek.umn.edu/tools/declare/sort.d.pdf

"Paul Richardson" wrote in message
news:5213243@discussion.autodesk.com...
you need to reference the "microsoft scripting runtime" but the
idea doesn't work anyway...I should have tired it first..

"Paul Richardson" wrote in message
news:5213225@discussion.autodesk.com...
Here ya go...Very simple I just subtracted the Y insertion
point from the X insertion point and used the difference to
sort.

[code]
Option Explicit
Const dictKey = 1
Const dictItem = 2

Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData

Dim Dict As Scripting.Dictionary
Set Dict = SSToDictionary(SS)
SortDictionary Dict, dictItem

'iterate sorted collection use Dict.Key to get
'the ents.
Dim i As Integer
Dim txt As AcadText
For i = 0 To Dict.Count - 1
Set txt = ThisDrawing.HandleToObject(Dict.Keys(i))
txt.TextString = i 'test only remove
'add to your table
Next i

Call SSRemove("test")

End Sub

'Add ss ents to Dictionary using ent.handle as key and ents
'(xIns - yIns) as item.
Function SSToDictionary(inSS As AcadSelectionSet) As Scripting.Dictionary
Dim i As Integer

Dim txt As AcadText
Dim Dict As New Scripting.Dictionary

For i = 0 To inSS.Count - 1
Set txt = inSS(i)
Dict.Add txt.Handle, _
(VBA.Round((CStr(txt.InsertionPoint(0) - txt.InsertionPoint(1))), 2))
Next i

Set SSToDictionary = Dict

End Function

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub

'Modified MSDN Function
Function SortDictionary(objDict, intSort)
' declare our variables
Dim Dict()
Dim objKey
Dim strKey, strItem
Dim X, Y, Z

' get the dictionary count
Z = objDict.Count

' we need more than one item to warrant sorting
If Z > 1 Then
' create an array to store dictionary information
ReDim Dict(Z, 2)
X = 0
' populate the array
For Each objKey In objDict
Dict(X, dictKey) = (objKey)
Dict(X, dictItem) = (objDict(objKey))
X = X + 1
Next

' perform a a shell sort of the string array
For X = 0 To (Z - 2)
For Y = X To (Z - 1)
If Dict(X, intSort) > Dict(Y, intSort) Then
strKey = Dict(X, dictKey)
strItem = Dict(X, dictItem)
Dict(X, dictKey) = Dict(Y, dictKey)
Dict(X, dictItem) = Dict(Y, dictItem)
Dict(Y, dictKey) = strKey
Dict(Y, dictItem) = strItem
End If
Next
Next

' erase the contents of the dictionary object
objDict.RemoveAll

' repopulate the dictionary with the sorted information
For X = 0 To (Z - 1)
objDict.Add Dict(X, dictKey), Dict(X, dictItem)
Next

End If

End Function
[/code]

"Dan" wrote in message
news:5213107@discussion.autodesk.com...
Thank you so much. I will attemp to incorporate this new code and
information into my routine.
Thanks again for all your help. When complete, this will save a tremendous
amount of rework.

Dan

"Paul Richardson" wrote in message
news:5213115@discussion.autodesk.com...
The nice thing is you don't have to know what is going in the sort
methods, just that it returns a sorted something for now...

That being said, here is code to add the x and y insertion coords to a 2d
array,
and then relate a sorted 2d array of insertion points back to entities in
your selection set.

You need a function to sort 2d arrays...google "Sort 2d coordinates" or such

[code]
Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
'filter data for TEXT
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData
'create 2d array (x,y) same size as your SS
ReDim coords(SS.Count - 1, 1)

Dim txtEnt As AcadText
Dim i As Integer

For i = 0 To SS.Count - 1
Set txtEnt = SS(i)
coords(i, 0) = txtEnt.InsertionPoint(0)
coords(i, 1) = txtEnt.InsertionPoint(1)
Next i

'now you have an array of 2d coordinates, do
'a google for a function that will sort 2d
'coordinate arrays.

Dim j As Integer
'relate sorted coords back to your SS ents
'doesn't consider duplicate insertion points
For i = LBound(coords) To UBound(coords)
For j = 0 To SS.Count - 1
Set txtEnt = SS(j)
If txtEnt.InsertionPoint(0) = coords(i, 0) And _
txtEnt.InsertionPoint(1) = coords(i, 1) Then
'add text value to your table
Exit For
End If
Next j
Next i

Call SSRemove("test")

End Sub

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub
[/code]

"Dan" wrote in message
news:5213024@discussion.autodesk.com...
I really do not understand most of what is happening in the heap sort
method, but I will learn it. I appreciate all the help. This code is much
more advanced than I have ever written. I was hoping to learn some new
tricks, but found a whole new area of coding I can explore.

Thanks again,
Dan

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Wed, 21 Jun 2006 15:19:08 GMT

Thank you, I will try to read more. I am a newbie at VBA, and this sorting
algorithun code is really unfamiliar to me.

"Paul Richardson" wrote in message
news:5213519@discussion.autodesk.com...
check out this link, it's in c but should give you
some ideas...
http://www.cedarcreek.umn.edu/tools/declare/sort.d.pdf

"Paul Richardson" wrote in message
news:5213243@discussion.autodesk.com...
you need to reference the "microsoft scripting runtime" but the
idea doesn't work anyway...I should have tired it first..

"Paul Richardson" wrote in message
news:5213225@discussion.autodesk.com...
Here ya go...Very simple I just subtracted the Y insertion
point from the X insertion point and used the difference to
sort.

[code]
Option Explicit
Const dictKey = 1
Const dictItem = 2

Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData

Dim Dict As Scripting.Dictionary
Set Dict = SSToDictionary(SS)
SortDictionary Dict, dictItem

'iterate sorted collection use Dict.Key to get
'the ents.
Dim i As Integer
Dim txt As AcadText
For i = 0 To Dict.Count - 1
Set txt = ThisDrawing.HandleToObject(Dict.Keys(i))
txt.TextString = i 'test only remove
'add to your table
Next i

Call SSRemove("test")

End Sub

'Add ss ents to Dictionary using ent.handle as key and ents
'(xIns - yIns) as item.
Function SSToDictionary(inSS As AcadSelectionSet) As Scripting.Dictionary
Dim i As Integer

Dim txt As AcadText
Dim Dict As New Scripting.Dictionary

For i = 0 To inSS.Count - 1
Set txt = inSS(i)
Dict.Add txt.Handle, _
(VBA.Round((CStr(txt.InsertionPoint(0) - txt.InsertionPoint(1))), 2))
Next i

Set SSToDictionary = Dict

End Function

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub

'Modified MSDN Function
Function SortDictionary(objDict, intSort)
' declare our variables
Dim Dict()
Dim objKey
Dim strKey, strItem
Dim X, Y, Z

' get the dictionary count
Z = objDict.Count

' we need more than one item to warrant sorting
If Z > 1 Then
' create an array to store dictionary information
ReDim Dict(Z, 2)
X = 0
' populate the array
For Each objKey In objDict
Dict(X, dictKey) = (objKey)
Dict(X, dictItem) = (objDict(objKey))
X = X + 1
Next

' perform a a shell sort of the string array
For X = 0 To (Z - 2)
For Y = X To (Z - 1)
If Dict(X, intSort) > Dict(Y, intSort) Then
strKey = Dict(X, dictKey)
strItem = Dict(X, dictItem)
Dict(X, dictKey) = Dict(Y, dictKey)
Dict(X, dictItem) = Dict(Y, dictItem)
Dict(Y, dictKey) = strKey
Dict(Y, dictItem) = strItem
End If
Next
Next

' erase the contents of the dictionary object
objDict.RemoveAll

' repopulate the dictionary with the sorted information
For X = 0 To (Z - 1)
objDict.Add Dict(X, dictKey), Dict(X, dictItem)
Next

End If

End Function
[/code]

"Dan" wrote in message
news:5213107@discussion.autodesk.com...
Thank you so much. I will attemp to incorporate this new code and
information into my routine.
Thanks again for all your help. When complete, this will save a tremendous
amount of rework.

Dan

"Paul Richardson" wrote in message
news:5213115@discussion.autodesk.com...
The nice thing is you don't have to know what is going in the sort
methods, just that it returns a sorted something for now...

That being said, here is code to add the x and y insertion coords to a 2d
array,
and then relate a sorted 2d array of insertion points back to entities in
your selection set.

You need a function to sort 2d arrays...google "Sort 2d coordinates" or such

[code]
Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
'filter data for TEXT
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData
'create 2d array (x,y) same size as your SS
ReDim coords(SS.Count - 1, 1)

Dim txtEnt As AcadText
Dim i As Integer

For i = 0 To SS.Count - 1
Set txtEnt = SS(i)
coords(i, 0) = txtEnt.InsertionPoint(0)
coords(i, 1) = txtEnt.InsertionPoint(1)
Next i

'now you have an array of 2d coordinates, do
'a google for a function that will sort 2d
'coordinate arrays.

Dim j As Integer
'relate sorted coords back to your SS ents
'doesn't consider duplicate insertion points
For i = LBound(coords) To UBound(coords)
For j = 0 To SS.Count - 1
Set txtEnt = SS(j)
If txtEnt.InsertionPoint(0) = coords(i, 0) And _
txtEnt.InsertionPoint(1) = coords(i, 1) Then
'add text value to your table
Exit For
End If
Next j
Next i

Call SSRemove("test")

End Sub

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub
[/code]

"Dan" wrote in message
news:5213024@discussion.autodesk.com...
I really do not understand most of what is happening in the heap sort
method, but I will learn it. I appreciate all the help. This code is much
more advanced than I have ever written. I was hoping to learn some new
tricks, but found a whole new area of coding I can explore.

Thanks again,
Dan

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Wed, 21 Jun 2006 15:34:39 GMT

Did you have an opportunity to view my example drawing? I have 1000's of
files with this configuration, I am trying to update.
Fatty was kind enough to assist me with the initial code, but I am still
hung up on the sorting. Did you have an opportunity to run the existing
code? If you select the text object individually, in order, the code works
great, but when I have 164 entities, this will be to tedious, and time
consuming.

Once again, I appreciate your time and efforts.

Dan

"Dan" wrote in message
news:5213872@discussion.autodesk.com...
Thank you, I will try to read more. I am a newbie at VBA, and this sorting
algorithun code is really unfamiliar to me.

"Paul Richardson" wrote in message
news:5213519@discussion.autodesk.com...
check out this link, it's in c but should give you
some ideas...
http://www.cedarcreek.umn.edu/tools/declare/sort.d.pdf

"Paul Richardson" wrote in message
news:5213243@discussion.autodesk.com...
you need to reference the "microsoft scripting runtime" but the
idea doesn't work anyway...I should have tired it first..

"Paul Richardson" wrote in message
news:5213225@discussion.autodesk.com...
Here ya go...Very simple I just subtracted the Y insertion
point from the X insertion point and used the difference to
sort.

[code]
Option Explicit
Const dictKey = 1
Const dictItem = 2

Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData

Dim Dict As Scripting.Dictionary
Set Dict = SSToDictionary(SS)
SortDictionary Dict, dictItem

'iterate sorted collection use Dict.Key to get
'the ents.
Dim i As Integer
Dim txt As AcadText
For i = 0 To Dict.Count - 1
Set txt = ThisDrawing.HandleToObject(Dict.Keys(i))
txt.TextString = i 'test only remove
'add to your table
Next i

Call SSRemove("test")

End Sub

'Add ss ents to Dictionary using ent.handle as key and ents
'(xIns - yIns) as item.
Function SSToDictionary(inSS As AcadSelectionSet) As Scripting.Dictionary
Dim i As Integer

Dim txt As AcadText
Dim Dict As New Scripting.Dictionary

For i = 0 To inSS.Count - 1
Set txt = inSS(i)
Dict.Add txt.Handle, _
(VBA.Round((CStr(txt.InsertionPoint(0) - txt.InsertionPoint(1))), 2))
Next i

Set SSToDictionary = Dict

End Function

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub

'Modified MSDN Function
Function SortDictionary(objDict, intSort)
' declare our variables
Dim Dict()
Dim objKey
Dim strKey, strItem
Dim X, Y, Z

' get the dictionary count
Z = objDict.Count

' we need more than one item to warrant sorting
If Z > 1 Then
' create an array to store dictionary information
ReDim Dict(Z, 2)
X = 0
' populate the array
For Each objKey In objDict
Dict(X, dictKey) = (objKey)
Dict(X, dictItem) = (objDict(objKey))
X = X + 1
Next

' perform a a shell sort of the string array
For X = 0 To (Z - 2)
For Y = X To (Z - 1)
If Dict(X, intSort) > Dict(Y, intSort) Then
strKey = Dict(X, dictKey)
strItem = Dict(X, dictItem)
Dict(X, dictKey) = Dict(Y, dictKey)
Dict(X, dictItem) = Dict(Y, dictItem)
Dict(Y, dictKey) = strKey
Dict(Y, dictItem) = strItem
End If
Next
Next

' erase the contents of the dictionary object
objDict.RemoveAll

' repopulate the dictionary with the sorted information
For X = 0 To (Z - 1)
objDict.Add Dict(X, dictKey), Dict(X, dictItem)
Next

End If

End Function
[/code]

"Dan" wrote in message
news:5213107@discussion.autodesk.com...
Thank you so much. I will attemp to incorporate this new code and
information into my routine.
Thanks again for all your help. When complete, this will save a tremendous
amount of rework.

Dan

"Paul Richardson" wrote in message
news:5213115@discussion.autodesk.com...
The nice thing is you don't have to know what is going in the sort
methods, just that it returns a sorted something for now...

That being said, here is code to add the x and y insertion coords to a 2d
array,
and then relate a sorted 2d array of insertion points back to entities in
your selection set.

You need a function to sort 2d arrays...google "Sort 2d coordinates" or such

[code]
Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
'filter data for TEXT
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData
'create 2d array (x,y) same size as your SS
ReDim coords(SS.Count - 1, 1)

Dim txtEnt As AcadText
Dim i As Integer

For i = 0 To SS.Count - 1
Set txtEnt = SS(i)
coords(i, 0) = txtEnt.InsertionPoint(0)
coords(i, 1) = txtEnt.InsertionPoint(1)
Next i

'now you have an array of 2d coordinates, do
'a google for a function that will sort 2d
'coordinate arrays.

Dim j As Integer
'relate sorted coords back to your SS ents
'doesn't consider duplicate insertion points
For i = LBound(coords) To UBound(coords)
For j = 0 To SS.Count - 1
Set txtEnt = SS(j)
If txtEnt.InsertionPoint(0) = coords(i, 0) And _
txtEnt.InsertionPoint(1) = coords(i, 1) Then
'add text value to your table
Exit For
End If
Next j
Next i

Call SSRemove("test")

End Sub

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub
[/code]

"Dan" wrote in message
news:5213024@discussion.autodesk.com...
I really do not understand most of what is happening in the heap sort
method, but I will learn it. I appreciate all the help. This code is much
more advanced than I have ever written. I was hoping to learn some new
tricks, but found a whole new area of coding I can explore.

Thanks again,
Dan

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Wed, 21 Jun 2006 15:53:56 GMT

I saw the drawing. I gave you code to sort via dictionary, or collection.
You need to figure out the double sort; most of us are long past the
recursion
semester... your turn.:) Not that recursion is the only way to go.

How about an easy way out. Use Excel model to sort by Column1(x) and
then by Column2(Y).

Use the idea I sent creating a multiple dimension array...
ReDim arr(ss.Count - 1, 2)
(X Y Handle)

Now let Excel sort for you and then use the handle (column3) to get back to
your
entity.

"Dan" wrote in message
news:5213900@discussion.autodesk.com...
Did you have an opportunity to view my example drawing? I have 1000's of
files with this configuration, I am trying to update.
Fatty was kind enough to assist me with the initial code, but I am still
hung up on the sorting. Did you have an opportunity to run the existing
code? If you select the text object individually, in order, the code works
great, but when I have 164 entities, this will be to tedious, and time
consuming.

Once again, I appreciate your time and efforts.

Dan

"Dan" wrote in message
news:5213872@discussion.autodesk.com...
Thank you, I will try to read more. I am a newbie at VBA, and this sorting
algorithun code is really unfamiliar to me.

"Paul Richardson" wrote in message
news:5213519@discussion.autodesk.com...
check out this link, it's in c but should give you
some ideas...
http://www.cedarcreek.umn.edu/tools/declare/sort.d.pdf

"Paul Richardson" wrote in message
news:5213243@discussion.autodesk.com...
you need to reference the "microsoft scripting runtime" but the
idea doesn't work anyway...I should have tired it first..

"Paul Richardson" wrote in message
news:5213225@discussion.autodesk.com...
Here ya go...Very simple I just subtracted the Y insertion
point from the X insertion point and used the difference to
sort.

[code]
Option Explicit
Const dictKey = 1
Const dictItem = 2

Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData

Dim Dict As Scripting.Dictionary
Set Dict = SSToDictionary(SS)
SortDictionary Dict, dictItem

'iterate sorted collection use Dict.Key to get
'the ents.
Dim i As Integer
Dim txt As AcadText
For i = 0 To Dict.Count - 1
Set txt = ThisDrawing.HandleToObject(Dict.Keys(i))
txt.TextString = i 'test only remove
'add to your table
Next i

Call SSRemove("test")

End Sub

'Add ss ents to Dictionary using ent.handle as key and ents
'(xIns - yIns) as item.
Function SSToDictionary(inSS As AcadSelectionSet) As Scripting.Dictionary
Dim i As Integer

Dim txt As AcadText
Dim Dict As New Scripting.Dictionary

For i = 0 To inSS.Count - 1
Set txt = inSS(i)
Dict.Add txt.Handle, _
(VBA.Round((CStr(txt.InsertionPoint(0) - txt.InsertionPoint(1))), 2))
Next i

Set SSToDictionary = Dict

End Function

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub

'Modified MSDN Function
Function SortDictionary(objDict, intSort)
' declare our variables
Dim Dict()
Dim objKey
Dim strKey, strItem
Dim X, Y, Z

' get the dictionary count
Z = objDict.Count

' we need more than one item to warrant sorting
If Z > 1 Then
' create an array to store dictionary information
ReDim Dict(Z, 2)
X = 0
' populate the array
For Each objKey In objDict
Dict(X, dictKey) = (objKey)
Dict(X, dictItem) = (objDict(objKey))
X = X + 1
Next

' perform a a shell sort of the string array
For X = 0 To (Z - 2)
For Y = X To (Z - 1)
If Dict(X, intSort) > Dict(Y, intSort) Then
strKey = Dict(X, dictKey)
strItem = Dict(X, dictItem)
Dict(X, dictKey) = Dict(Y, dictKey)
Dict(X, dictItem) = Dict(Y, dictItem)
Dict(Y, dictKey) = strKey
Dict(Y, dictItem) = strItem
End If
Next
Next

' erase the contents of the dictionary object
objDict.RemoveAll

' repopulate the dictionary with the sorted information
For X = 0 To (Z - 1)
objDict.Add Dict(X, dictKey), Dict(X, dictItem)
Next

End If

End Function
[/code]

"Dan" wrote in message
news:5213107@discussion.autodesk.com...
Thank you so much. I will attemp to incorporate this new code and
information into my routine.
Thanks again for all your help. When complete, this will save a tremendous
amount of rework.

Dan

"Paul Richardson" wrote in message
news:5213115@discussion.autodesk.com...
The nice thing is you don't have to know what is going in the sort
methods, just that it returns a sorted something for now...

That being said, here is code to add the x and y insertion coords to a 2d
array,
and then relate a sorted 2d array of insertion points back to entities in
your selection set.

You need a function to sort 2d arrays...google "Sort 2d coordinates" or such

[code]
Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
'filter data for TEXT
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData
'create 2d array (x,y) same size as your SS
ReDim coords(SS.Count - 1, 1)

Dim txtEnt As AcadText
Dim i As Integer

For i = 0 To SS.Count - 1
Set txtEnt = SS(i)
coords(i, 0) = txtEnt.InsertionPoint(0)
coords(i, 1) = txtEnt.InsertionPoint(1)
Next i

'now you have an array of 2d coordinates, do
'a google for a function that will sort 2d
'coordinate arrays.

Dim j As Integer
'relate sorted coords back to your SS ents
'doesn't consider duplicate insertion points
For i = LBound(coords) To UBound(coords)
For j = 0 To SS.Count - 1
Set txtEnt = SS(j)
If txtEnt.InsertionPoint(0) = coords(i, 0) And _
txtEnt.InsertionPoint(1) = coords(i, 1) Then
'add text value to your table
Exit For
End If
Next j
Next i

Call SSRemove("test")

End Sub

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub
[/code]

"Dan" wrote in message
news:5213024@discussion.autodesk.com...
I really do not understand most of what is happening in the heap sort
method, but I will learn it. I appreciate all the help. This code is much
more advanced than I have ever written. I was hoping to learn some new
tricks, but found a whole new area of coding I can explore.

Thanks again,
Dan

Re: Sort an array of text objects Asc by their X and Y insertion point values

Anonymous — Wed, 21 Jun 2006 16:59:31 GMT

Thank you for your efforts and time. I appreciate it.
I do not understand your examples to begin with, so it is hard to use ideas
and principles from the various code you have provided.
I am self taught at VBA, and rarely given any time to code new routines with
my drafting schedule.
I can and do respect your intentions to help, and teach me, but I am really
clueless about working with arrays.
I have thought about the easy way out by using Excel. Wouldn't it be much
slower?
What did you mean by "use the handle (column3) to get back to your entity."?
Is this the object ID?
BTW, if you use my current code, do you have a clue why the table updates so
slowly?

I am reading up on arrays right now. The developer help isn't much help in
this area that I can see.

Dan

"Paul Richardson" wrote in message
news:5213930@discussion.autodesk.com...
I saw the drawing. I gave you code to sort via dictionary, or collection.
You need to figure out the double sort; most of us are long past the
recursion
semester... your turn.:) Not that recursion is the only way to go.

How about an easy way out. Use Excel model to sort by Column1(x) and
then by Column2(Y).

Use the idea I sent creating a multiple dimension array...
ReDim arr(ss.Count - 1, 2)
(X Y Handle)

Now let Excel sort for you and then use the handle (column3) to get back to
your
entity.

"Dan" wrote in message
news:5213900@discussion.autodesk.com...
Did you have an opportunity to view my example drawing? I have 1000's of
files with this configuration, I am trying to update.
Fatty was kind enough to assist me with the initial code, but I am still
hung up on the sorting. Did you have an opportunity to run the existing
code? If you select the text object individually, in order, the code works
great, but when I have 164 entities, this will be to tedious, and time
consuming.

Once again, I appreciate your time and efforts.

Dan

"Dan" wrote in message
news:5213872@discussion.autodesk.com...
Thank you, I will try to read more. I am a newbie at VBA, and this sorting
algorithun code is really unfamiliar to me.

"Paul Richardson" wrote in message
news:5213519@discussion.autodesk.com...
check out this link, it's in c but should give you
some ideas...
http://www.cedarcreek.umn.edu/tools/declare/sort.d.pdf

"Paul Richardson" wrote in message
news:5213243@discussion.autodesk.com...
you need to reference the "microsoft scripting runtime" but the
idea doesn't work anyway...I should have tired it first..

"Paul Richardson" wrote in message
news:5213225@discussion.autodesk.com...
Here ya go...Very simple I just subtracted the Y insertion
point from the X insertion point and used the difference to
sort.

[code]
Option Explicit
Const dictKey = 1
Const dictItem = 2

Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData

Dim Dict As Scripting.Dictionary
Set Dict = SSToDictionary(SS)
SortDictionary Dict, dictItem

'iterate sorted collection use Dict.Key to get
'the ents.
Dim i As Integer
Dim txt As AcadText
For i = 0 To Dict.Count - 1
Set txt = ThisDrawing.HandleToObject(Dict.Keys(i))
txt.TextString = i 'test only remove
'add to your table
Next i

Call SSRemove("test")

End Sub

'Add ss ents to Dictionary using ent.handle as key and ents
'(xIns - yIns) as item.
Function SSToDictionary(inSS As AcadSelectionSet) As Scripting.Dictionary
Dim i As Integer

Dim txt As AcadText
Dim Dict As New Scripting.Dictionary

For i = 0 To inSS.Count - 1
Set txt = inSS(i)
Dict.Add txt.Handle, _
(VBA.Round((CStr(txt.InsertionPoint(0) - txt.InsertionPoint(1))), 2))
Next i

Set SSToDictionary = Dict

End Function

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub

'Modified MSDN Function
Function SortDictionary(objDict, intSort)
' declare our variables
Dim Dict()
Dim objKey
Dim strKey, strItem
Dim X, Y, Z

' get the dictionary count
Z = objDict.Count

' we need more than one item to warrant sorting
If Z > 1 Then
' create an array to store dictionary information
ReDim Dict(Z, 2)
X = 0
' populate the array
For Each objKey In objDict
Dict(X, dictKey) = (objKey)
Dict(X, dictItem) = (objDict(objKey))
X = X + 1
Next

' perform a a shell sort of the string array
For X = 0 To (Z - 2)
For Y = X To (Z - 1)
If Dict(X, intSort) > Dict(Y, intSort) Then
strKey = Dict(X, dictKey)
strItem = Dict(X, dictItem)
Dict(X, dictKey) = Dict(Y, dictKey)
Dict(X, dictItem) = Dict(Y, dictItem)
Dict(Y, dictKey) = strKey
Dict(Y, dictItem) = strItem
End If
Next
Next

' erase the contents of the dictionary object
objDict.RemoveAll

' repopulate the dictionary with the sorted information
For X = 0 To (Z - 1)
objDict.Add Dict(X, dictKey), Dict(X, dictItem)
Next

End If

End Function
[/code]

"Dan" wrote in message
news:5213107@discussion.autodesk.com...
Thank you so much. I will attemp to incorporate this new code and
information into my routine.
Thanks again for all your help. When complete, this will save a tremendous
amount of rework.

Dan

"Paul Richardson" wrote in message
news:5213115@discussion.autodesk.com...
The nice thing is you don't have to know what is going in the sort
methods, just that it returns a sorted something for now...

That being said, here is code to add the x and y insertion coords to a 2d
array,
and then relate a sorted 2d array of insertion points back to entities in
your selection set.

You need a function to sort 2d arrays...google "Sort 2d coordinates" or such

[code]
Sub Stub()
Dim SS As AcadSelectionSet
Dim filType(0) As Integer
Dim filData(0)
'filter data for TEXT
filType(0) = 0
filData(0) = "TEXT"

Set SS = SSAdd("test")
SS.SelectOnScreen filType, filData
'create 2d array (x,y) same size as your SS
ReDim coords(SS.Count - 1, 1)

Dim txtEnt As AcadText
Dim i As Integer

For i = 0 To SS.Count - 1
Set txtEnt = SS(i)
coords(i, 0) = txtEnt.InsertionPoint(0)
coords(i, 1) = txtEnt.InsertionPoint(1)
Next i

'now you have an array of 2d coordinates, do
'a google for a function that will sort 2d
'coordinate arrays.

Dim j As Integer
'relate sorted coords back to your SS ents
'doesn't consider duplicate insertion points
For i = LBound(coords) To UBound(coords)
For j = 0 To SS.Count - 1
Set txtEnt = SS(j)
If txtEnt.InsertionPoint(0) = coords(i, 0) And _
txtEnt.InsertionPoint(1) = coords(i, 1) Then
'add text value to your table
Exit For
End If
Next j
Next i

Call SSRemove("test")

End Sub

Function SSAdd(inName As String) As AcadSelectionSet
On Error Resume Next
With ThisDrawing
.SelectionSets(inName).Delete
Set SSAdd = .SelectionSets.Add(inName)
End With
End Function

Sub SSRemove(inName As String)
On Error Resume Next
ThisDrawing.SelectionSets(inName).Delete
End Sub
[/code]

"Dan" wrote in message
news:5213024@discussion.autodesk.com...
I really do not understand most of what is happening in the heap sort
method, but I will learn it. I appreciate all the help. This code is much
more advanced than I have ever written. I was hoping to learn some new
tricks, but found a whole new area of coding I can explore.

Thanks again,
Dan