Custom variable table
Here's a modified version of the sample from the API Help. I think the problem you ran into running it is the difference in arrays between VBA and VB.Net. I've modified this version so that it will be compatible with both and I've changed it so it outputs the table in your example, with the exception that the custom table doesn't support merging a column so they are still individual cells.
Public Sub CreateCustomTable()
' Set a reference to the drawing document.
' This assumes a drawing document is active.
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
' Set a reference to the active sheet.
Dim oSheet As Sheet
Set oSheet = oDrawDoc.ActiveSheet
Dim columnCount As Integer
Dim rowCount As Integer
columnCount = 4
rowCount = 6
' Set the column titles
Dim titles() As String
ReDim titles(columnCount - 1)
titles(0) = "SPIDER"
titles(1) = "IMB"
titles(2) = "PROCEDURE"
titles(3) = "'A' DIMENSION"
' Set the contents of the custom table (contents are set row-wise)
Dim contents() As String
ReDim contents(columnCount * rowCount - 1)
Dim row As Integer
row = 0
contents(4 * row) = "F25"
contents(4 * row + 1) = "S-10090-2"
contents(4 * row + 2) = "S15020-A"
contents(4 * row + 3) = "33.25 [844.5]"
row = row + 1
contents(4 * row) = "F26"
contents(4 * row + 1) = "S-10090-2"
contents(4 * row + 2) = "S15020-A"
contents(4 * row + 3) = "33.25 [844.5]"
row = row + 1
contents(4 * row) = "F27"
contents(4 * row + 1) = "S-10090-2"
contents(4 * row + 2) = "S15020-A"
contents(4 * row + 3) = "33.25 [844.5]"
row = row + 1
contents(4 * row) = "F28"
contents(4 * row + 1) = "S-10090-2"
contents(4 * row + 2) = "S15020-A"
contents(4 * row + 3) = "33.25 [844.5]"
row = row + 1
contents(4 * row) = "F29"
contents(4 * row + 1) = "S-10090-2"
contents(4 * row + 2) = "S15020-A"
contents(4 * row + 3) = "33.25 [844.5]"
row = row + 1
contents(4 * row) = "F30"
contents(4 * row + 1) = "S-10090-2"
contents(4 * row + 2) = "S15020-A"
contents(4 * row + 3) = "33.25 [844.5]"
' Set the column widths (defaults to the column title width if not specified)
Dim columnWidths() As Double
ReDim columnWidths(columnCount - 1)
columnWidths(0) = 2.5
columnWidths(1) = 3
columnWidths(2) = 3
columnWidths(3) = 3.5
' Create the custom table
Dim oCustomTable As CustomTable
Set oCustomTable = oSheet.CustomTables.Add( _
"IMB WELDING", ThisApplication.TransientGeometry.CreatePoint2d(15, 15), _
columnCount, rowCount, titles, contents, columnWidths)
End Sub
There anyway create a macro to merge the cell "TOTAL MASS" erase the firsts lines in merge the setence "TOTAL MASS"?
There create a macro to calculate the total mass:
Sub testTotalMass()
Dim dwg As DrawingDocument
Set dwg = ThisApplication.ActiveDocument
Dim oview As DrawingView
Set oview = ThisApplication.CommandManager.Pick(kDrawingViewFilter, "Pick the assembly view")
On Error Resume Next
Dim asm As AssemblyDocument
Set asm = oview.ReferencedDocumentDescriptor.ReferencedDocument
If Err Then
MsgBox ("Not an assembly")
Exit Sub
End If
Dim pl As PartsList
Set pl = dwg.ActiveSheet.PartsLists.Item(1)
Dim plr As PartsListRow
Dim found As Boolean
For Each plr In pl.PartsListRows
If plr.Item(3).Value = "TOTAL MASS" Then
found = True
Exit For
End If
Next
Dim txn As Transaction
Set txn = ThisApplication.TransactionManager.StartTransaction(dwg, "Add total mass")
If found = False Then Set plr = pl.PartsListRows.Add(pl.PartsListRows.Count, False)
plr.Item(3).Value = "TOTAL MASS"
plr.Item(5).Value = Round(asm.ComponentDefinition.MassProperties.Mass, 3) & " kg"
txn.End
End Sub