Sorting a Selection Set

[jhomamah]

Hi all. I have (below) a VBA program which takes a group of selected text objects and re-numbers them automatically based on a user input starting number (or letter). The problem is when I window in a group of objects, the resulting auto-numbering is not in any recognizable order (left to right or top to bottom). I need to be able to sort the output by object position (X and then Y). If I select individually it works fine because I am building the array order myself but if I window in a group weird things happen.


EX: Need this . . . 1 2 3 . . . but get this . . . 5 6 8
4 5 6 9 2 1
7 8 9 3 7 4

I am no expert in handling arrays and would appreciate any insight even if it is a total overhaul of the current code.

Here is what I am using now:

[VBA]
Option Explicit
Private Sub cmdRenumber_Click()
Dim varUserInput As Variant
Dim varPrefix As String
Dim varSuffix As String
Dim objACAD As AcadApplication
Dim objDOC As AcadDocument
Dim objNEWSS As AcadSelectionSet
Dim varPT1 As Variant
Dim intGroupCode(0 To 4) As Integer
Dim varGroupValue(0 To 4) As Variant
Dim entTypeConstant As String
Dim i As Integer
Dim attribs As Variant
intGroupCode(0) = -4
varGroupValue(0) = "<OR"
intGroupCode(1) = 0
varGroupValue(1) = "insert"
intGroupCode(2) = 0
varGroupValue(2) = "text"
intGroupCode(3) = 0
varGroupValue(3) = "mtext"
intGroupCode(4) = "-4"
varGroupValue(4) = "OR>"
varUserInput = frmReNumber.txtStartNumber.Text
varPrefix = frmReNumber.txtPrefix.Text
varSuffix = frmReNumber.txtSuffix.Text
Set objACAD = ThisDrawing.Application
Set objDOC = objACAD.ActiveDocument
On Error Resume Next
objDOC.SelectionSets.Item("VBA").Delete
Err.Clear
Set objNEWSS = objDOC.SelectionSets.Add("VBA")
frmReNumber.Hide
PickOnScreeN:
objNEWSS.SelectOnScreen intGroupCode, varGroupValue
If objNEWSS.Count = 0 Then GoTo PickOnScreeN
For i = 0 To objNEWSS.Count - 1
entTypeConstant = objNEWSS.Item(i).EntityType
If entTypeConstant = acText Or entTypeConstant = acMtext Then
objNEWSS.Item(i).TextString = varPrefix & varUserInput & varSuffix
objNEWSS.Item(i).Update
End If
If entTypeConstant = acBlockReference Then
attribs = objNEWSS.Item(i).GetAttributes
attribs(0).TextString = varUserInput
attribs(0).Update
End If
frmReNumber.txtStartNumber.Text = AddtoCharacter(varUserInput, 1)
varUserInput = frmReNumber.txtStartNumber.Text
Next
If Not objNEWSS Is Nothing Then objNEWSS.Delete
frmReNumber.Show
End Sub
Function AddtoCharacter(varUseramount As Variant, intUserAmountToADD As Integer) As Variant
Dim intValue As Variant
Select Case Asc(varUseramount)
Case 65 To 89
If Chr(Asc(varUseramount)) = varUseramount Then
intValue = Asc(varUseramount) + intUserAmountToADD
intValue = Chr(intValue)
End If
Case Else
intValue = varUseramount + intUserAmountToADD
End Select
AddtoCharacter = intValue
End Function


[/VBA]

Thanks, Jhomamah



EDIT: Added VBA code tags - Tommy

[Tommy]

Hi Jhomamah,

Welcome to VBAexpress!

In the code posted I do not see where you are sorting the insertion points.

You also don't have to make the user select the objects, you can select all of the objects and filter them out the ones you don't want.
One of the problems with sorting mtext insertion points is the alignment, top right, lower left, ....and then to make it really hairy the "bounding box" of mtext does not always match the text location.
It would also be best to post a sample, with the macro and form so we can have the same information you have. After removing all personal information.

[fixo]

Hi Jhomamah
Sorry for the late
Attached is the way that may helps
This was written for my own needs but
you can use TableSort function

~'J'~

[jhomamah]

Fatty. Thanks so much! I'll add it to my code and let you know how I make out.
Jhomamah