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

[Anonymous]

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

[Anonymous]

I have figured out how to filter for Text and Mtex.
I have figured out how to send the coords array to a sort algorithum, i.e.
heap but it errors out.
What am I doing wrong?

Heap code found here:
http://www.xtremevbtalk.com/showthread.php?t=78889


"Dan" wrote in message
news:5214059@discussion.autodesk.com...
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

[Anonymous]

[code]

Sub Stub()
Dim SS As AcadSelectionSet
Dim FilterType(3) As Integer
Dim FilterData(3) As Variant
'Dim filType(0) As Integer
'Dim filData(0)
'filter data for TEXT
'filType(0) = 0
'filData(0) = "TEXT"

FilterType(0) = -4
FilterData(0) = " FilterType(1) = 0
FilterData(1) = "TEXT"
FilterType(2) = 0
FilterData(2) = "MTEXT"
FilterType(3) = -4
FilterData(3) = "or>"

Set SS = SSAdd("test")
SS.SelectOnScreen FilterType, FilterData
'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) ' need to fix this to work with mtext too
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.
Call HEAPSort(coords)


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



Public Sub HEAPSort(ByRef lngArray() As Variant)
Dim iLBound As Long
Dim iUBound As Long
Dim iArrSize As Long
Dim iRoot As Long
Dim iChild As Long
Dim iElement As Long
Dim iCurrent As Long
Dim arrOut() As Long

iLBound = LBound(lngArray)
iUBound = UBound(lngArray)
iArrSize = iUBound - iLBound

ReDim arrOut(iLBound To iUBound)

'Initialise the heap
'Move up the heap from the bottom
For iRoot = iArrSize \ 2 To 0 Step -1

iElement = lngArray(iRoot + iLBound)
iChild = iRoot + iRoot

'Move down the heap from the current position
Do While iChild < iArrSize

If iChild < iArrSize Then
If lngArray(iChild + iLBound) < lngArray(iChild + iLBound +
1) Then
'Always want largest child
iChild = iChild + 1
End If
End If

'Found a slot, stop looking
If iElement >= lngArray(iChild + iLBound) Then Exit Do

lngArray((iChild \ 2) + iLBound) = lngArray(iChild + iLBound)
iChild = iChild + iChild
Loop

'Move the node
lngArray((iChild \ 2) + iLBound) = iElement
Next iRoot

'Read of values one by one (store in array starting at the end)
For iRoot = iUBound To iLBound Step -1

'Read the value
arrOut(iRoot) = lngArray(iLBound)
'Get the last element
iElement = lngArray(iArrSize + iLBound)

iArrSize = iArrSize - 1
iCurrent = 0
iChild = 1

'Find a place for the last element to go
Do While iChild <= iArrSize

If iChild < iArrSize Then
If lngArray(iChild + iLBound) < lngArray(iChild + iLBound +
1) Then
'Always want the larger child
iChild = iChild + 1
End If
End If

'Found a position
If iElement >= lngArray(iChild + iLBound) Then Exit Do

lngArray(iCurrent + iLBound) = lngArray(iChild + iLBound)
iCurrent = iChild
iChild = iChild + iChild

Loop

'Move the node
lngArray(iCurrent + iLBound) = iElement
Next iRoot

'Copy from temp array to real array
For iRoot = iLBound To iUBound
lngArray(iRoot) = arrOut(iRoot)
Next iRoot
End Sub
[/code]


"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
"Dan" wrote in message
news:5214280@discussion.autodesk.com...
I have figured out how to filter for Text and Mtex.
I have figured out how to send the coords array to a sort algorithum, i.e.
heap but it errors out.
What am I doing wrong?

Heap code found here:
http://www.xtremevbtalk.com/showthread.php?t=78889


"Dan" wrote in message
news:5214059@discussion.autodesk.com...
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

[Anonymous]

I suspect it's because your array to sort is 2D Arr(x,y), but HeapSort expects a 1D array, Arr(x).

[Anonymous]

Chewing on your problem, I think one way would be to sort by X value first, then create subcollections of equal X values and resort
those by Y value and replace the original items in the collection.

I'm enjoying this discussion, and if I can clear up some time I may join in!

[Anonymous]

Thanks! I am sure my ignorance is entertaining as well..oh well, I will
learn something out of this.
Thanks again
I am about to pull my hair out. This is really confusing stuff.

"Allen Johnson" wrote in message
news:5214330@discussion.autodesk.com...
Chewing on your problem, I think one way would be to sort by X value first,
then create subcollections of equal X values and resort
those by Y value and replace the original items in the collection.

I'm enjoying this discussion, and if I can clear up some time I may join in!

[Anonymous]

I was thinking sorting by Y first. Now you have your objects
top to bottom. Now iterate your sorted Y's in decending order
adding to an array (coll or dict) until a different Y is found
Sort this array group by X value(left to right)

o group1
ooo group2
oooo groupN




"Allen Johnson" wrote in message
news:5214330@discussion.autodesk.com...
Chewing on your problem, I think one way would be to sort by X value first,
then create subcollections of equal X values and resort
those by Y value and replace the original items in the collection.

I'm enjoying this discussion, and if I can clear up some time I may join in!

[Anonymous]

Allen, I posted this assuming you would write it up...:)

"Paul Richardson" wrote in message
news:5214409@discussion.autodesk.com...
I was thinking sorting by Y first. Now you have your objects
top to bottom. Now iterate your sorted Y's in decending order
adding to an array (coll or dict) until a different Y is found
Sort this array group by X value(left to right)

o group1
ooo group2
oooo groupN




"Allen Johnson" wrote in message
news:5214330@discussion.autodesk.com...
Chewing on your problem, I think one way would be to sort by X value first,
then create subcollections of equal X values and resort
those by Y value and replace the original items in the collection.

I'm enjoying this discussion, and if I can clear up some time I may join in!

[Anonymous]

Obviously depending on how you sorted...
"Paul Richardson" wrote in message
news:5214409@discussion.autodesk.com...
I was thinking sorting by Y first. Now you have your objects
top to bottom. Now iterate your sorted Y's in decending order
adding to an array (coll or dict) until a different Y is found
Sort this array group by X value(left to right)

o group1
ooo group2
oooo groupN




"Allen Johnson" wrote in message
news:5214330@discussion.autodesk.com...
Chewing on your problem, I think one way would be to sort by X value first,
then create subcollections of equal X values and resort
those by Y value and replace the original items in the collection.

I'm enjoying this discussion, and if I can clear up some time I may join in!

[Anonymous]

Does this sound like a possible app? Currently I hope to populate a table
in cad, but later I hope to skip the table, and go straight to excel for
other apps, but not this where I wish to go at this point....Baby steps.
"Paul Richardson" wrote in message
news:5214431@discussion.autodesk.com...

Obviously depending on how you sorted...
"Paul Richardson" wrote in message
news:5214409@discussion.autodesk.com...
I was thinking sorting by Y first. Now you have your objects
top to bottom. Now iterate your sorted Y's in decending order
adding to an array (coll or dict) until a different Y is found
Sort this array group by X value(left to right)

o group1
ooo group2
oooo groupN




"Allen Johnson" wrote in message
news:5214330@discussion.autodesk.com...
Chewing on your problem, I think one way would be to sort by X value first,
then create subcollections of equal X values and resort
those by Y value and replace the original items in the collection.

I'm enjoying this discussion, and if I can clear up some time I may join in!

[Anonymous]

Either way, X or Y, the concept is the same.....

[Anonymous]

Is it the same?
Would the sort order, and Acs/Dsc come up with a different arrangement?



if I have text

A B
C D

I need SS in order of A,C,B,D. Unless I just need to start all over, I am
willing

Hair is going!
\
\ . . . . /
( o o )
-

"Allen Johnson" wrote in message
news:5214491@discussion.autodesk.com...
Either way, X or Y, the concept is the same.....

[Anonymous]

I appreciate everyone's help. Like anything in ACAD there many ways to
accomplish the same task. Having a need is the way I learn best, and this
thread will be a great learning experience that I can incorporate into
future applications. I hope others will benefit as well overtime.


"Dan" wrote in message
news:5214524@discussion.autodesk.com...
Is it the same?
Would the sort order, and Acs/Dsc come up with a different arrangement?



if I have text

A B
C D

I need SS in order of A,C,B,D. Unless I just need to start all over, I am
willing

Hair is going!
\
\ . . . . /
( o o )
-

"Allen Johnson" wrote in message
news:5214491@discussion.autodesk.com...
Either way, X or Y, the concept is the same.....

[Anonymous]

there is; the only reason I said Y first is it seemed to fit better with
your Top to bottom - Left to right schema.. maybe not.

"Dan" wrote in message
news:5214588@discussion.autodesk.com...
I appreciate everyone's help. Like anything in ACAD there many ways to
accomplish the same task. Having a need is the way I learn best, and this
thread will be a great learning experience that I can incorporate into
future applications. I hope others will benefit as well overtime.


"Dan" wrote in message
news:5214524@discussion.autodesk.com...
Is it the same?
Would the sort order, and Acs/Dsc come up with a different arrangement?



if I have text

A B
C D

I need SS in order of A,C,B,D. Unless I just need to start all over, I am
willing

Hair is going!
\
\ . . . . /
( o o )
-

"Allen Johnson" wrote in message
news:5214491@discussion.autodesk.com...
Either way, X or Y, the concept is the same.....

[Anonymous]

make that Left to Right - Top to Bottom

"Paul Richardson" wrote in message
news:5214578@discussion.autodesk.com...
there is; the only reason I said Y first is it seemed to fit better with
your Top to bottom - Left to right schema.. maybe not.

"Dan" wrote in message
news:5214588@discussion.autodesk.com...
I appreciate everyone's help. Like anything in ACAD there many ways to
accomplish the same task. Having a need is the way I learn best, and this
thread will be a great learning experience that I can incorporate into
future applications. I hope others will benefit as well overtime.


"Dan" wrote in message
news:5214524@discussion.autodesk.com...
Is it the same?
Would the sort order, and Acs/Dsc come up with a different arrangement?



if I have text

A B
C D

I need SS in order of A,C,B,D. Unless I just need to start all over, I am
willing

Hair is going!
\
\ . . . . /
( o o )
-

"Allen Johnson" wrote in message
news:5214491@discussion.autodesk.com...
Either way, X or Y, the concept is the same.....

[Anonymous]

This seems to work fine...For testing I just
change textstring to it's order. Needs some
refactoring, I'll leave that to you.

Add a reference to "Microsoft Scripting Runtime"

[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 tempDict As New Scripting.Dictionary
Dim finalDict As New Scripting.Dictionary
Dim dict As Scripting.Dictionary

Set dict = TextSSToDictionary(SS)

SortDictionary dict, dictItem, True

Dim i As Integer, j As Integer
Dim txt As AcadText

'TODO refactor...
For i = 0 To dict.count - 1
Set txt = ThisDrawing.HandleToObject(dict.Keys(i))
tempDict.Add dict.Keys(i), txt.InsertionPoint(0)
If i <> dict.count - 1 Then
If dict.Items(i) <> dict.Items(i + 1) Then
SortDictionary tempDict, dictItem
For j = 0 To tempDict.count - 1
finalDict.Add tempDict.Keys(j), tempDict.Items(j)
Next j
tempDict.RemoveAll
End If
End If
Next i

'add last group
SortDictionary tempDict, dictItem
For j = 0 To tempDict.count - 1
finalDict.Add tempDict.Keys(j), tempDict.Items(j)
Next j
'TODO refactor...

'TEST
For i = 0 To finalDict.count - 1
Set txt = ThisDrawing.HandleToObject(finalDict.Keys(i))
txt.TextString = i
Next i
'TEST

Call SSRemove("test")

End Sub


Function TextSSToDictionary(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, txt.InsertionPoint(1)
Next i

Set TextSSToDictionary = 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


Function SortDictionary(objDict, intSort, Optional decending As Boolean)
' declare our variables
Dim strDict()
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 strDict(Z, 2)
X = 0
' populate the string array
For Each objKey In objDict
strDict(X, dictKey) = CStr(objKey)
strDict(X, dictItem) = CStr(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 StrComp(strDict(X, intSort), strDict(Y, intSort), vbTextCompare)
> 0 Then
strKey = strDict(X, dictKey)
strItem = strDict(X, dictItem)
strDict(X, dictKey) = strDict(Y, dictKey)
strDict(X, dictItem) = strDict(Y, dictItem)
strDict(Y, dictKey) = strKey
strDict(Y, dictItem) = strItem
End If
Next
Next

' erase the contents of the dictionary object
objDict.RemoveAll

' repopulate the dictionary with the sorted information
Dim lower As Double: lower = 0
Dim upper As Double: upper = (Z - 1)
Dim stp As Integer: stp = 1

'accending or decending
Select Case decending
Case True
lower = upper
upper = 0
stp = -1
End Select

For X = lower To upper Step stp
objDict.Add strDict(X, dictKey), CDbl(strDict(X, dictItem))
Next

End If

End Function
[/code]


"Dan" wrote in message
news:5211212@discussion.autodesk.com...
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

[Anonymous]

Thank you so much, I am working on it now.
I have learned a great deal with this code.
Dan

"Paul Richardson" wrote in message
news:5214692@discussion.autodesk.com...
This seems to work fine...For testing I just
change textstring to it's order. Needs some
refactoring, I'll leave that to you.

Add a reference to "Microsoft Scripting Runtime"

[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 tempDict As New Scripting.Dictionary
Dim finalDict As New Scripting.Dictionary
Dim dict As Scripting.Dictionary

Set dict = TextSSToDictionary(SS)

SortDictionary dict, dictItem, True

Dim i As Integer, j As Integer
Dim txt As AcadText

'TODO refactor...
For i = 0 To dict.count - 1
Set txt = ThisDrawing.HandleToObject(dict.Keys(i))
tempDict.Add dict.Keys(i), txt.InsertionPoint(0)
If i <> dict.count - 1 Then
If dict.Items(i) <> dict.Items(i + 1) Then
SortDictionary tempDict, dictItem
For j = 0 To tempDict.count - 1
finalDict.Add tempDict.Keys(j), tempDict.Items(j)
Next j
tempDict.RemoveAll
End If
End If
Next i

'add last group
SortDictionary tempDict, dictItem
For j = 0 To tempDict.count - 1
finalDict.Add tempDict.Keys(j), tempDict.Items(j)
Next j
'TODO refactor...

'TEST
For i = 0 To finalDict.count - 1
Set txt = ThisDrawing.HandleToObject(finalDict.Keys(i))
txt.TextString = i
Next i
'TEST

Call SSRemove("test")

End Sub


Function TextSSToDictionary(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, txt.InsertionPoint(1)
Next i

Set TextSSToDictionary = 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


Function SortDictionary(objDict, intSort, Optional decending As Boolean)
' declare our variables
Dim strDict()
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 strDict(Z, 2)
X = 0
' populate the string array
For Each objKey In objDict
strDict(X, dictKey) = CStr(objKey)
strDict(X, dictItem) = CStr(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 StrComp(strDict(X, intSort), strDict(Y, intSort), vbTextCompare)
> 0 Then
strKey = strDict(X, dictKey)
strItem = strDict(X, dictItem)
strDict(X, dictKey) = strDict(Y, dictKey)
strDict(X, dictItem) = strDict(Y, dictItem)
strDict(Y, dictKey) = strKey
strDict(Y, dictItem) = strItem
End If
Next
Next

' erase the contents of the dictionary object
objDict.RemoveAll

' repopulate the dictionary with the sorted information
Dim lower As Double: lower = 0
Dim upper As Double: upper = (Z - 1)
Dim stp As Integer: stp = 1

'accending or decending
Select Case decending
Case True
lower = upper
upper = 0
stp = -1
End Select

For X = lower To upper Step stp
objDict.Add strDict(X, dictKey), CDbl(strDict(X, dictItem))
Next

End If

End Function
[/code]


"Dan" wrote in message
news:5211212@discussion.autodesk.com...
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

[Anonymous]

I could have added some comments if I was
nice...:)

Feel free to ask what I was thinking...
Should be somewhat self explainatory..

"Dan" wrote in message
news:5215428@discussion.autodesk.com...
Thank you so much, I am working on it now.
I have learned a great deal with this code.
Dan

"Paul Richardson" wrote in message
news:5214692@discussion.autodesk.com...
This seems to work fine...For testing I just
change textstring to it's order. Needs some
refactoring, I'll leave that to you.

Add a reference to "Microsoft Scripting Runtime"

[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 tempDict As New Scripting.Dictionary
Dim finalDict As New Scripting.Dictionary
Dim dict As Scripting.Dictionary

Set dict = TextSSToDictionary(SS)

SortDictionary dict, dictItem, True

Dim i As Integer, j As Integer
Dim txt As AcadText

'TODO refactor...
For i = 0 To dict.count - 1
Set txt = ThisDrawing.HandleToObject(dict.Keys(i))
tempDict.Add dict.Keys(i), txt.InsertionPoint(0)
If i <> dict.count - 1 Then
If dict.Items(i) <> dict.Items(i + 1) Then
SortDictionary tempDict, dictItem
For j = 0 To tempDict.count - 1
finalDict.Add tempDict.Keys(j), tempDict.Items(j)
Next j
tempDict.RemoveAll
End If
End If
Next i

'add last group
SortDictionary tempDict, dictItem
For j = 0 To tempDict.count - 1
finalDict.Add tempDict.Keys(j), tempDict.Items(j)
Next j
'TODO refactor...

'TEST
For i = 0 To finalDict.count - 1
Set txt = ThisDrawing.HandleToObject(finalDict.Keys(i))
txt.TextString = i
Next i
'TEST

Call SSRemove("test")

End Sub


Function TextSSToDictionary(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, txt.InsertionPoint(1)
Next i

Set TextSSToDictionary = 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


Function SortDictionary(objDict, intSort, Optional decending As Boolean)
' declare our variables
Dim strDict()
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 strDict(Z, 2)
X = 0
' populate the string array
For Each objKey In objDict
strDict(X, dictKey) = CStr(objKey)
strDict(X, dictItem) = CStr(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 StrComp(strDict(X, intSort), strDict(Y, intSort), vbTextCompare)
> 0 Then
strKey = strDict(X, dictKey)
strItem = strDict(X, dictItem)
strDict(X, dictKey) = strDict(Y, dictKey)
strDict(X, dictItem) = strDict(Y, dictItem)
strDict(Y, dictKey) = strKey
strDict(Y, dictItem) = strItem
End If
Next
Next

' erase the contents of the dictionary object
objDict.RemoveAll

' repopulate the dictionary with the sorted information
Dim lower As Double: lower = 0
Dim upper As Double: upper = (Z - 1)
Dim stp As Integer: stp = 1

'accending or decending
Select Case decending
Case True
lower = upper
upper = 0
stp = -1
End Select

For X = lower To upper Step stp
objDict.Add strDict(X, dictKey), CDbl(strDict(X, dictItem))
Next

End If

End Function
[/code]


"Dan" wrote in message
news:5211212@discussion.autodesk.com...
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

[Anonymous]

Thanks, I am stepping through code now, and researching what I do not
understand.
"Paul Richardson" wrote in message
news:5215640@discussion.autodesk.com...
I could have added some comments if I was
nice...:)

Feel free to ask what I was thinking...
Should be somewhat self explainatory..

"Dan" wrote in message
news:5215428@discussion.autodesk.com...
Thank you so much, I am working on it now.
I have learned a great deal with this code.
Dan

"Paul Richardson" wrote in message
news:5214692@discussion.autodesk.com...
This seems to work fine...For testing I just
change textstring to it's order. Needs some
refactoring, I'll leave that to you.

Add a reference to "Microsoft Scripting Runtime"

[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 tempDict As New Scripting.Dictionary
Dim finalDict As New Scripting.Dictionary
Dim dict As Scripting.Dictionary

Set dict = TextSSToDictionary(SS)

SortDictionary dict, dictItem, True

Dim i As Integer, j As Integer
Dim txt As AcadText

'TODO refactor...
For i = 0 To dict.count - 1
Set txt = ThisDrawing.HandleToObject(dict.Keys(i))
tempDict.Add dict.Keys(i), txt.InsertionPoint(0)
If i <> dict.count - 1 Then
If dict.Items(i) <> dict.Items(i + 1) Then
SortDictionary tempDict, dictItem
For j = 0 To tempDict.count - 1
finalDict.Add tempDict.Keys(j), tempDict.Items(j)
Next j
tempDict.RemoveAll
End If
End If
Next i

'add last group
SortDictionary tempDict, dictItem
For j = 0 To tempDict.count - 1
finalDict.Add tempDict.Keys(j), tempDict.Items(j)
Next j
'TODO refactor...

'TEST
For i = 0 To finalDict.count - 1
Set txt = ThisDrawing.HandleToObject(finalDict.Keys(i))
txt.TextString = i
Next i
'TEST

Call SSRemove("test")

End Sub


Function TextSSToDictionary(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, txt.InsertionPoint(1)
Next i

Set TextSSToDictionary = 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


Function SortDictionary(objDict, intSort, Optional decending As Boolean)
' declare our variables
Dim strDict()
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 strDict(Z, 2)
X = 0
' populate the string array
For Each objKey In objDict
strDict(X, dictKey) = CStr(objKey)
strDict(X, dictItem) = CStr(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 StrComp(strDict(X, intSort), strDict(Y, intSort), vbTextCompare)
> 0 Then
strKey = strDict(X, dictKey)
strItem = strDict(X, dictItem)
strDict(X, dictKey) = strDict(Y, dictKey)
strDict(X, dictItem) = strDict(Y, dictItem)
strDict(Y, dictKey) = strKey
strDict(Y, dictItem) = strItem
End If
Next
Next

' erase the contents of the dictionary object
objDict.RemoveAll

' repopulate the dictionary with the sorted information
Dim lower As Double: lower = 0
Dim upper As Double: upper = (Z - 1)
Dim stp As Integer: stp = 1

'accending or decending
Select Case decending
Case True
lower = upper
upper = 0
stp = -1
End Select

For X = lower To upper Step stp
objDict.Add strDict(X, dictKey), CDbl(strDict(X, dictItem))
Next

End If

End Function
[/code]


"Dan" wrote in message
news:5211212@discussion.autodesk.com...
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

[Anonymous]

the code under the comment 'add last group'
can be added as an 'Else' clause against
'If i <> dict.count - 1 Then'
...

Else
'add last group...
end if

I added it last and figured it was eaiser to read
where it was...

And again, I would refactor that whole block out to
it's own function...

"Dan" wrote in message
news:5215811@discussion.autodesk.com...
Thanks, I am stepping through code now, and researching what I do not
understand.
"Paul Richardson" wrote in message
news:5215640@discussion.autodesk.com...
I could have added some comments if I was
nice...:)

Feel free to ask what I was thinking...
Should be somewhat self explainatory..

"Dan" wrote in message
news:5215428@discussion.autodesk.com...
Thank you so much, I am working on it now.
I have learned a great deal with this code.
Dan

"Paul Richardson" wrote in message
news:5214692@discussion.autodesk.com...
This seems to work fine...For testing I just
change textstring to it's order. Needs some
refactoring, I'll leave that to you.

Add a reference to "Microsoft Scripting Runtime"

[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 tempDict As New Scripting.Dictionary
Dim finalDict As New Scripting.Dictionary
Dim dict As Scripting.Dictionary

Set dict = TextSSToDictionary(SS)

SortDictionary dict, dictItem, True

Dim i As Integer, j As Integer
Dim txt As AcadText

'TODO refactor...
For i = 0 To dict.count - 1
Set txt = ThisDrawing.HandleToObject(dict.Keys(i))
tempDict.Add dict.Keys(i), txt.InsertionPoint(0)
If i <> dict.count - 1 Then
If dict.Items(i) <> dict.Items(i + 1) Then
SortDictionary tempDict, dictItem
For j = 0 To tempDict.count - 1
finalDict.Add tempDict.Keys(j), tempDict.Items(j)
Next j
tempDict.RemoveAll
End If
End If
Next i

'add last group
SortDictionary tempDict, dictItem
For j = 0 To tempDict.count - 1
finalDict.Add tempDict.Keys(j), tempDict.Items(j)
Next j
'TODO refactor...

'TEST
For i = 0 To finalDict.count - 1
Set txt = ThisDrawing.HandleToObject(finalDict.Keys(i))
txt.TextString = i
Next i
'TEST

Call SSRemove("test")

End Sub


Function TextSSToDictionary(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, txt.InsertionPoint(1)
Next i

Set TextSSToDictionary = 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


Function SortDictionary(objDict, intSort, Optional decending As Boolean)
' declare our variables
Dim strDict()
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 strDict(Z, 2)
X = 0
' populate the string array
For Each objKey In objDict
strDict(X, dictKey) = CStr(objKey)
strDict(X, dictItem) = CStr(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 StrComp(strDict(X, intSort), strDict(Y, intSort), vbTextCompare)
> 0 Then
strKey = strDict(X, dictKey)
strItem = strDict(X, dictItem)
strDict(X, dictKey) = strDict(Y, dictKey)
strDict(X, dictItem) = strDict(Y, dictItem)
strDict(Y, dictKey) = strKey
strDict(Y, dictItem) = strItem
End If
Next
Next

' erase the contents of the dictionary object
objDict.RemoveAll

' repopulate the dictionary with the sorted information
Dim lower As Double: lower = 0
Dim upper As Double: upper = (Z - 1)
Dim stp As Integer: stp = 1

'accending or decending
Select Case decending
Case True
lower = upper
upper = 0
stp = -1
End Select

For X = lower To upper Step stp
objDict.Add strDict(X, dictKey), CDbl(strDict(X, dictItem))
Next

End If

End Function
[/code]


"Dan" wrote in message
news:5211212@discussion.autodesk.com...
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

[Anonymous]

Thanks Paul, I am still working on a few things, but I will get it all
going. Thanks again.
"Paul Richardson" wrote in message
news:5216064@discussion.autodesk.com...
the code under the comment 'add last group'
can be added as an 'Else' clause against
'If i <> dict.count - 1 Then'
...

Else
'add last group...
end if

I added it last and figured it was eaiser to read
where it was...

And again, I would refactor that whole block out to
it's own function...

"Dan" wrote in message
news:5215811@discussion.autodesk.com...
Thanks, I am stepping through code now, and researching what I do not
understand.
"Paul Richardson" wrote in message
news:5215640@discussion.autodesk.com...
I could have added some comments if I was
nice...:)

Feel free to ask what I was thinking...
Should be somewhat self explainatory..

"Dan" wrote in message
news:5215428@discussion.autodesk.com...
Thank you so much, I am working on it now.
I have learned a great deal with this code.
Dan

"Paul Richardson" wrote in message
news:5214692@discussion.autodesk.com...
This seems to work fine...For testing I just
change textstring to it's order. Needs some
refactoring, I'll leave that to you.

Add a reference to "Microsoft Scripting Runtime"

[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 tempDict As New Scripting.Dictionary
Dim finalDict As New Scripting.Dictionary
Dim dict As Scripting.Dictionary

Set dict = TextSSToDictionary(SS)

SortDictionary dict, dictItem, True

Dim i As Integer, j As Integer
Dim txt As AcadText

'TODO refactor...
For i = 0 To dict.count - 1
Set txt = ThisDrawing.HandleToObject(dict.Keys(i))
tempDict.Add dict.Keys(i), txt.InsertionPoint(0)
If i <> dict.count - 1 Then
If dict.Items(i) <> dict.Items(i + 1) Then
SortDictionary tempDict, dictItem
For j = 0 To tempDict.count - 1
finalDict.Add tempDict.Keys(j), tempDict.Items(j)
Next j
tempDict.RemoveAll
End If
End If
Next i

'add last group
SortDictionary tempDict, dictItem
For j = 0 To tempDict.count - 1
finalDict.Add tempDict.Keys(j), tempDict.Items(j)
Next j
'TODO refactor...

'TEST
For i = 0 To finalDict.count - 1
Set txt = ThisDrawing.HandleToObject(finalDict.Keys(i))
txt.TextString = i
Next i
'TEST

Call SSRemove("test")

End Sub


Function TextSSToDictionary(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, txt.InsertionPoint(1)
Next i

Set TextSSToDictionary = 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


Function SortDictionary(objDict, intSort, Optional decending As Boolean)
' declare our variables
Dim strDict()
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 strDict(Z, 2)
X = 0
' populate the string array
For Each objKey In objDict
strDict(X, dictKey) = CStr(objKey)
strDict(X, dictItem) = CStr(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 StrComp(strDict(X, intSort), strDict(Y, intSort), vbTextCompare)
> 0 Then
strKey = strDict(X, dictKey)
strItem = strDict(X, dictItem)
strDict(X, dictKey) = strDict(Y, dictKey)
strDict(X, dictItem) = strDict(Y, dictItem)
strDict(Y, dictKey) = strKey
strDict(Y, dictItem) = strItem
End If
Next
Next

' erase the contents of the dictionary object
objDict.RemoveAll

' repopulate the dictionary with the sorted information
Dim lower As Double: lower = 0
Dim upper As Double: upper = (Z - 1)
Dim stp As Integer: stp = 1

'accending or decending
Select Case decending
Case True
lower = upper
upper = 0
stp = -1
End Select

For X = lower To upper Step stp
objDict.Add strDict(X, dictKey), CDbl(strDict(X, dictItem))
Next

End If

End Function
[/code]


"Dan" wrote in message
news:5211212@discussion.autodesk.com...
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