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

[danderson.71652]

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)


Would it be easier to go directly from the initial SSet, to a new selection set in the order i want? I would like this better than the array.

Can anyone help me understand how this code woud work? I have very limites experience with sorting, and arrays, thanks.

Thanks

[danderson.71652]

Sort 2d coordinates-Put me outta my misery! Please!

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

If a dwg file would help you understand better, please let me know.


start(text on screen):
1 2 3
4 5 6
7 8 9

SSet creates bu user onscreen selection
SSet order(random is the key here)): 2,4,7,8,0,1,5,3,6,9
Sorted order(desired order I want):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.

I am no VBA by far, and I am getting to the point of pulling my hair out!

Thank you for any kind assistance.

I was trying to use the sorting methods here, but I get error messages I do not understand when sending an array to them. I was trying heap and quick methods.
http://www.xtremevbtalk.com/showthread.php?t=78889



My code so far:

removed code, didn't work anyway

[danderson.71652]

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?

Code provided to me with some modifications.

removed code, didn't work anyway

[danderson.71652]

Crickets......I am not about to start an argument with myself even though I am currently the only person to reply, any Experts out there to put me out of my misery?

(kidding, trying to laugh at the situation)

[Ed Jobe]

Sorry Dan...been working. You might specify what "errors out", when and how.

[danderson.71652]

Biggest problem is I do not understand Arrays, I am trying to learn quickly, but it is above my experience and understanding currently.
If I oush the coords array to the Heapsort, I error on line:
iElement = lngArray(iRoot + iLBound)

I do not understand the code to even know how to describe it.

[Ed Jobe]

You deal with arrays all the time! The table of numbers you gave in the first post is an array. In a one dimensional array, think of a list of items:
A
B
C
D
etc.
In this case, the dimension number is how many rows are there? A. 4.
In the case of your table, it is a two dimensional array, 3 columns by 3 rows. To specify a value, you need to refer to its column, number and row number, i.e. its index. 5 is at 2,2. These are the most common arrays people deal with. You can add more dimensions. The coordinate system of your acad drawing is a 3 dimensional array of points. Instead of referring to a point's index as row and column, which are terms used for 2d arrays, you use x, y and z to refer to a location. In your dwg you would draw something at that location. In a data array, you store data at that location. That's all there is to it.

Sorting is a little trickier. You can move the data from one location to another based upon some scheme or you can build another array pointing to the first, which returns the values in the order needed. But you have to have some criteria to sort upon. For example, if you had a 2d array that listed street names in the first cell and street numbers in the second cell, which do you sort on? Presumably, you would sort the street name first in ascending order and then by number in ascending order. In your table, do you want to sort by row first and then column or vice versa? X or Y?

[danderson.71652]

I am attching a zip that I think will help.
This code works to do wha I want if the user selects each entitiy in the proper order
top-down/left-right.

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 FilterType(3) As Integer
Dim FilterData(3) 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

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

    On Error Resume Next
    ThisDrawing.SelectionSets.Item("FieldsToTable").Delete
    Set oSset = ThisDrawing.SelectionSets.Add("FieldsToTable")
    On Error GoTo ErrMsg
    oSset.SelectOnScreen FilterType, FilterData
    
    '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

[zoomharis]

Crickets......I am not about to start an argument with myself even though I am currently the only person to reply, any Experts out ther to put me out of my misery?

Hi Danderson,
Sorry for being late. We understand your feelings. But the same time, most of the people here are working in some companies and are unable to sit in a relaxed mood to find a quick solution to certain questions (I don't mean every problem). So be patient with us if we are little bit late.

Based on your first post, I have done some coding. Again sorry for not going through all your codes. I hope you can incorporate this logic with your program. It sorts the text by X coordinates and if the X coordinates are same, it then sorts by Y axis. Just try this code

 
Sub SortTextByPos()
Dim objTxt As AcadText
Dim objSSet As AcadSelectionSet
Dim gpCode(0) As Integer: Dim dataVal(0) As Variant
Set objSSet = ThisDrawing.SelectionSets.Add("TxtSet")
gpCode(0) = 0: dataVal(0) = "Text"
ReSelect:
objSSet.SelectOnScreen gpCode, dataVal
If objSSet.Count <> 0 Then
	Dim TxtPnt As Variant
	Dim arTxtPnts() As Variant
	Dim TxtBasePnt(0 To 1) As Double
	Dim iDim As Integer
	iDim = 0
	ReDim Preserve arTxtPnts(objSSet.Count - 1, 2)
	For Each objTxt In objSSet
		If objTxt.Alignment = acAlignmentLeft Then
			TxtPnt = objTxt.InsertionPoint
		Else
			TxtPnt = objTxt.TextAlignmentPoint
		End If
		TxtBasePnt(0) = TxtPnt(0): TxtBasePnt(1) = TxtPnt(1)
		arTxtPnts(iDim, 0) = TxtPnt(0)
		arTxtPnts(iDim, 1) = TxtPnt(1)
		arTxtPnts(iDim, 2) = objTxt.TextString
		iDim = iDim + 1
	Next
	arTxtPnts = SortArrayByCoords(arTxtPnts)
	'<-- Display values for checking -->
	Dim strOP As String
	strOP = strOP & "X Coordinate" & vbTab & vbTab & "Y Coordinate" & _
	vbTab & vbTab & "Text" & vbCrLf
	strOP = strOP & String(22, "-") & vbTab & vbTab & String(22, "-") & _
	vbTab & vbTab & String(5, "-") & vbCrLf
	For i = 0 To UBound(arTxtPnts)
		strOP = strOP & arTxtPnts(i, 0) & vbTab & vbTab & arTxtPnts(i, 1) & _
		vbTab & vbTab & arTxtPnts(i, 2) & vbCrLf
	Next
	MsgBox strOP
	'<-- End display -->
	objSSet.Delete
End If
End Sub

Function SortArrayByCoords(ByVal arSource As Variant)
	Dim i As Integer
	Dim j As Integer
	Dim dblTmpVal(2)
	For i = UBound(arSource) To LBound(arSource) Step -1
	   For j = LBound(arSource) + 1 To i
	   '<-- Check for the X coordinates first and if they are equel -
	   '<-- compare the the Y coordinates -->
		 If ( _
				(arSource(j - 1, 0) > arSource(j, 0)) _
				Or ( _
				(arSource(j - 1, 0) = arSource(j, 0)) _
				And _
				(arSource(j - 1, 1) < arSource(j, 1)) _
				) _
			) Then
		   dblTmpVal(0) = arSource(j - 1, 0)
		   dblTmpVal(1) = arSource(j - 1, 1)
		   dblTmpVal(2) = arSource(j - 1, 2)
		   arSource(j - 1, 0) = arSource(j, 0)
		   arSource(j - 1, 1) = arSource(j, 1)
		   arSource(j - 1, 2) = arSource(j, 2)
		   arSource(j, 0) = dblTmpVal(0)
		   arSource(j, 1) = dblTmpVal(1)
		   arSource(j, 2) = dblTmpVal(2)
		 End If
	   Next j
	 Next i
  SortArrayByCoords = arSource
End Function

Is it ok Danderson....? Please give us a feedback.


har!s

[danderson.71652]

"The best way to make your dreams come true is to Wake Up."
I like that!

The code is genius! I have been pulling my hair out for 3 days. I did not mean to rush or sound impatient with the crickets comment, I was trying to add a little humor to my ignorance.

I believe this is exactly the direction I am going...I just need to incorporate it into my exiting code

Please look at the line "' PLEASE READ THIS COMMENT" in the 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 FilterType(3) As Integer
Dim FilterData(3) 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

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

    On Error Resume Next
    ThisDrawing.SelectionSets.Item("FieldsToTable").Delete
    Set oSset = ThisDrawing.SelectionSets.Add("FieldsToTable")
    On Error GoTo ErrMsg
    oSset.SelectOnScreen FilterType, FilterData

' PLEASE READ THIS COMMENT    
'sorting goes here into array, then sort, then back into array, then into a new selectionset
'can this be done?


    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