View Full Version : Sorting a Selection Set

09-23-2007, 04:51 AM
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:

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
Set objNEWSS = objDOC.SelectionSets.Add("VBA")
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
End If
If entTypeConstant = acBlockReference Then
attribs = objNEWSS.Item(i).GetAttributes
attribs(0).TextString = varUserInput
End If
frmReNumber.txtStartNumber.Text = AddtoCharacter(varUserInput, 1)
varUserInput = frmReNumber.txtStartNumber.Text
If Not objNEWSS Is Nothing Then objNEWSS.Delete
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

Thanks, Jhomamah

EDIT: Added VBA code tags - Tommy

09-24-2007, 06:00 AM
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. :)

09-30-2007, 12:56 PM
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


10-03-2007, 11:40 AM
Fatty. Thanks so much! I'll add it to my code and let you know how I make out.