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 notices you have at least three threads on this going...
you must be busy...:o)

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

[Anonymous]

True, Learning much. Still havn't got everything working perfectly yet, but
I am working on in, when time is permitted. I had to hold off and get a
project out, but I will be back on it soon.
Thanks again.

"Paul Richardson" wrote in message
news:5217764@discussion.autodesk.com...
I notices you have at least three threads on this going...
you must be busy...:o)

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