I have modified the rule you supplied above as the move sub routine had being replaced by another sub routine. Regarding Cell 1, the revision box will populate if the revision table is new to the sheet. We are simply automating the manual process for using autoindexing shown in the image.
and these are the lines that carry out this
oRTB = oRTBs.Add2(oTablePt,False, True, False, "0" )
and here is the explanation of this call and what variable to modify
'add a new revision table instructions
'RevisionTables.Add2( PlacementPoint As Point2d, [IsSheetScope] As Boolean,
'[AutoIndex] As Boolean, [AlphaIndex] As Boolean, [StartValue] As String,
'[RevisionTableStyle] As Variant, [Layer] As Variant ) As RevisionTable
and this line takes the revision table REV number and places in the iproperty revision number
oRTB.UpdatePropertyToRevisionNumber = True
So this leads to the next question are you modifying a lot of revision tables that are existing? If there is only a handful you could just delete and recreate with the auto indexing switched on. This way when you manually have to modify the revision box and add a row everything works the same.
Working Rule:
Sub Main
Dim oDrawDoc As DrawingDocument
oDrawDoc = ThisApplication.ActiveDocument
Dim oSheet As Sheet
oSheet = oDrawDoc.ActiveSheet
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
Dim oTablePt As Point2d = oTG.CreatePoint2d(0, 0)'loosely position Table
Dim oRevStyle As RevisionTableStyle
Dim oRevTable As RevisionTable
oRevStyle = oDrawDoc.StylesManager.RevisionTableStyles.Item("Revision Table (ISO)")'Revision Table (ISO)'You can enter in a revision style by name sample "Rev Table 1"
Neigh = 0
If oSheet.RevisionTables.Count = 1 Then
Call Positiontable(oTablePt,oSheet)
oRevTable = oSheet.RevisionTables.Item(1)
'Change RevTable Style
oRevTable.Style = oRevStyle
Dim oRow As RevisionTableRow
oRow = oRevTable.RevisionTableRows.Item(oRevTable.RevisionTableRows.Count)
'Enter 1st row Contents
booleanParam = InputRadioBox("Pick One", "Continue Editing Current REV", "Add REV",True, Title := "Revision Box Options")
If booleanParam = True
Call RevisionTableContents(oRow)
ElseIf booleanParam = False
Dim oRows As RevisionTableRows = oRevTable.RevisionTableRows
'add new empty row
oRows.Add()
Call Positiontable(oTablePt,oSheet)
'Get current Row by counting
oRow = oRevTable.RevisionTableRows.Item(oRevTable.RevisionTableRows.Count)
'Add new row contents
Call RevisionTableContents(oRow)
End If
Else If oSheet.RevisionTables.Count = 0 Then
Dim oRTBs As RevisionTables
oRTBs = oSheet.RevisionTables
'add a new revision table instructions
'RevisionTables.Add2( PlacementPoint As Point2d, [IsSheetScope] As Boolean,
'[AutoIndex] As Boolean, [AlphaIndex] As Boolean, [StartValue] As String,
'[RevisionTableStyle] As Variant, [Layer] As Variant ) As RevisionTable
Dim oRTB As RevisionTable
oRTB = oRTBs.Add2(oTablePt,False, True, False, "0" )'oLocation
'Position Table after initial insert
Call Positiontable(oTablePt, oSheet)
oRevTable = oSheet.RevisionTables.Item(1)
'Change RevTable Style
oRevTable.Style = oRevStyle
Dim oRow As RevisionTableRow
oRow = oRevTable.RevisionTableRows.Item(oRevTable.RevisionTableRows.Count)
If oRow.IsActiveRow Then
'Enter 1st row Contents
Call RevisionTableContents(oRow)
'ensure rev block is set to write to iProperty, This can be modified in two places in the editor and in the template when placing
oRTB.UpdatePropertyToRevisionNumber = True
End If
End If
Call Positiontable(oTablePt,oSheet)
End Sub
Sub RevisionTableContents(oRow)
'[Revision COL 2 Date
Dim oCell2 As RevisionTableCell = oRow.Item(2)
'Set it equal to the the current date, date format change from Computer default
oCell2.Text= DateTime.Now.ToString("dd-MM-yyyy")
'dt.ToString("dd/MMMM yyyy, dddd")
'[Revision COL 3 Description
Dim MyArrayList3 As New ArrayList
MyArrayList3.Add("FOR CUSTOMER REVIEW")
MyArrayList3.Add("FOR CUSTOMER APPROVAL")
MyArrayList3.Add("INITIAL RELEASE")
MyArrayList3.Add("ENTER CUSTOM COMMENT")
oArray3 = InputListBox("Select one:", MyArrayList3, "", "iLogic", "REV Description")
If oArray3 = "" Then
ElseIf oArray3 = "ENTER CUSTOM COMMENT" Then
oInput3 = UCase(InputBox("What did you change?", "REV", "UPDATED REVISION...."))
If oInput3 = "" Then
Else
Dim oCell3 As RevisionTableCell = oRow.Item(3)
oCell3.Text = oInput3
End If
Else
Dim oCell3 As RevisionTableCell = oRow.Item(3)
oCell3.Text = oArray3
End If
']
'[Revision COL 4 Approved
Dim MyArrayList4 As New ArrayList
MyArrayList4.Add("John")
MyArrayList4.Add("Markinson")
MyArrayList4.Add("Jeff")
oArray4 = InputListBox("Select one:", MyArrayList4, "", "iLogic", "Approved By")
If oArray4 = "" Then
Else
Dim oCell4 As RevisionTableCell = oRow.Item(4)
oCell4.Text = oArray4
End If
']
'[Revision COL 5 Zone
Dim MyArrayList5 As New ArrayList
MyArrayList5.Add("-")
MyArrayList5.Add("A1")
MyArrayList5.Add("A2")
MyArrayList5.Add("B1")
oArray5 = InputListBox("Select one:", MyArrayList5, "", "iLogic", "Zone Changes ")
If oArray5 = "" Then
Else
Dim oCell5 As RevisionTableCell = oRow.Item(5)
oCell5.Text = oArray5
End If
End Sub
']
Private Sub Positiontable( oTablePt As Point2d,oSheet As Sheet)
Dim oRevTableItem As RevisionTable
oRevTableItem = oSheet.RevisionTables.Item(1)
Dim oWidthRevTable As Double
oWidthRevTable = oRevTableItem.RangeBox.MaxPoint.X - oRevTableItem.RangeBox.MinPoint.X
Dim oHeightRevTable As Double
oHeightRevTable = oRevTableItem.RangeBox.MaxPoint.Y - oRevTableItem.RangeBox.MinPoint.Y
oTablePt = ThisApplication.TransientGeometry.CreatePoint2d(oSheet.Border.RangeBox.MaxPoint.X - oWidthRevTable, oSheet.TitleBlock.RangeBox.MaxPoint.Y + oHeightRevTable)
oRevTableItem.Position = oTablePt
End Sub
If this solved a problem, please click (accept) as solution.
Or if this helped you, please, click (like)
Regards
Alan
