jhomamah
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.
:motz2:
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
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
Thanks, Jhomamah
:bow:
EDIT: Added VBA code tags - Tommy
:motz2:
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
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
Thanks, Jhomamah
:bow:
EDIT: Added VBA code tags - Tommy