TABLE AUTO FIT COLUMNS

[GosponZ]

I'm inserting tables with ilogic and going very smooth. The thing is i need to auto fit columns in table so tables to look better., and i do have rule to auto fit columns. So i run rule to insert table and then PICK table to run another rule to fit columns. My question is is it possible to run both rules at once  or to run both rules but to pick table maybe in between rules. Just to save time and clicking.

Thank you all

[R.Mabery]

Is your second rule running off the selection set?  If so, modify that to grab the table.  

If you post your code, I can help.

[GosponZ]

Sub Main()
	If Not ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
		MessageBox.Show("Can only run rule on drawing documents.")
		Exit Sub
	End If
	
	Dim oDrawDoc As DrawingDocument
	oDrawDoc = ThisApplication.ActiveDocument
	
	Dim oSheet As Sheet
	oSheet = oDrawDoc.Sheets.Item(1)
	
'	For Each oPL As PartsList In oSheet.partslists
		
'	Next
	
	Dim oSelectSet As SelectSet
	oSelectSet = oDrawDoc.SelectSet
	
	If oSelectSet.Count = 0 Then Exit Sub
	If oSelectSet.Item(1).Type <> kPartsListObject Then Exit Sub
		
	Dim oPartslist As PartsList
	oPartslist = oSelectSet.Item(1)
	
	PartsListFitColumns(oPartslist)
	
End Sub

Public Function PartsListFitColumns(oPartsList As PartsList) As PartsList

	If oPartsList Is Nothing Then Exit Function

	' get font info
	Dim dWidth As Double
	dWidth = oPartsList.DataTextStyle.FontSize * oPartsList.DataTextStyle.WidthScale


	' find longest string in each column and resize column
	Dim oRow As PartsListRow
	Dim sData As String
	Dim iCol As Integer
	Dim iCols As Integer

	iCols = oPartsList.PartsListColumns.Count

	' set up array to hold column widths
	Dim iLen() As Integer
	ReDim iLen(iCols)

	' initialize to header lengths
	For iCol = 1 To iCols
		iLen(iCol) = Len(oPartsList.PartsListColumns(iCol).Title)
	Next iCol

	' loop thru each row
	For Each oRow In oPartsList.PartsListRows
		If oRow.Visible = True Then
			For iCol = 1 To iCols
				sData = oRow.Item(iCol).Value ' get the data from the cell
				
				If Len(sData) > iLen(iCol) Then
					iLen(iCol) = Len(sData)
				End If
			Next iCol
		End If
	Next oRow

	' resize the columns (note add extra 2 character width for padding)
	For iCol = 1 To iCols
		oPartsList.PartsListColumns(iCol).Width = dWidth * (iLen(iCol) + 2) / 1.3
	Next iCol

	Return oPartsList
End Function

Ok here is the code, and thanks for reply

[R.Mabery]

If you only have 1 parts list on this sheet, then change: 

oPartslist = oSelectSet.Item(1)

to

oPartslist = oSheet.PartsLists.Item(1)

If you have more than 1 parts list on this sheet, then you'll have to have  a way of knowing which one, either by # or by title or something that differientiates.

[WCrihfield]

You could have your first rule run the second rule at the end.  You may be able to provide 'arguments' (NameValueMap) to the method you use to run the other rule, which may help you avoid the use of the 'Pick' method to manually select it again.  Here is a link to one of my contribution posts that show how to set this up.

If this solved your problem, or answered your question, please click ACCEPT SOLUTION.
Or, if this helped you, please click (LIKE or KUDOS) 👍.

If you want and have time, I would appreciate your Vote(s) for My IDEAS 💡or you can Explore My CONTRIBUTIONS

[GosponZ]

It will not work on on custom part list, like single part in table. It is working on parts list where header state parts list

[GosponZ]

I tried to run as one rule both of them but will not work

here is insert table  but if can combine this two. Arguments beyond me but learning.

Sub Main()

'Declare local variables
Dim oDrawDoc As DrawingDocument
Dim oSheet As Sheet
Dim oDrawingView As DrawingView
Dim oPlacementPoint As Point2d
Dim oPartsList As PartsList 
Dim oBorder As Border
Dim oStyle As String
Dim oPlaceX As Double
Dim oPlaceY As Double

'initialize variables
oDrawDoc = ThisApplication.ActiveDocument
oSheet = oDrawDoc.ActiveSheet
oDrawingView = oSheet.DrawingViews(1)
oBorder = oSheet.Border

'user input - select parts list style
oStyle = InputListBox("Choose Parts List Style", MultiValue.List("PartsListStyle"), "Custom Parts List (CUSTOMER)","Parts List Style", "List Prompt") 


'create parts list
oPartsList = oSheet.PartsLists.Add(oDrawingView, oBorder.RangeBox.MinPoint)
oPartsList.Style = oDrawDoc.StylesManager.PartsListStyles.Item(oStyle)

'reposition parts list to top left
oPlaceX = oBorder.RangeBox.MaxPoint.X' - (oPartsList.RangeBox.MaxPoint.X + oPartsList.RangeBox.MinPoint.X)'+(1.27)
oPlaceY = oBorder.RangeBox.MaxPoint.Y 
oPlacementPoint = ThisApplication.TransientGeometry.CreatePoint2d(oPlaceX,oPlaceY)
oPartsList.Position = oPlacementPoint

End Sub

[R.Mabery]

If you're inserting the Parts List, then you don't need to get it again as you already have it.  The line below returns the Parts List object:

oPartsList = oSheet.PartsLists.Add(oDrawingView, oBorder.RangeBox.MinPoint)

[GosponZ]

I'm using this parts list and it place straight to upper right corner of my border, and i like it, but since column is always same size and descriptions change i would like to fit columns just for better look. That is why i"m using second rule to adjust columns. Now if i can run one rule to run both of them would be perfect scenario. To insert  table and adjust columns.

Thank you all guys for help

[R.Mabery · Accepted solution]

Try this:

Sub Main()

	'Declare local variables
	Dim oDrawDoc As DrawingDocument
	Dim oSheet As Sheet
	Dim oDrawingView As DrawingView
	Dim oPlacementPoint As Point2d
	Dim oPartsList As PartsList 
	Dim oBorder As Border
	Dim oStyle As String
	Dim oPlaceX As Double
	Dim oPlaceY As Double

	'initialize variables
	oDrawDoc = ThisApplication.ActiveDocument
	oSheet = oDrawDoc.ActiveSheet
	oDrawingView = oSheet.DrawingViews(1)
	oBorder = oSheet.Border

	' user input - select parts list style
	' oStyle = InputListBox("Choose Parts List Style", MultiValue.List("PartsListStyle"), "Custom Parts List (CUSTOMER)","Parts List Style", "List Prompt") 


	'create parts list
	oPartsList = oSheet.PartsLists.Add(oDrawingView, oBorder.RangeBox.MinPoint)
	' oPartsList.Style = oDrawDoc.StylesManager.PartsListStyles.Item(oStyle)

	'reposition parts list to top left
	oPlaceX = oBorder.RangeBox.MaxPoint.X' - (oPartsList.RangeBox.MaxPoint.X + oPartsList.RangeBox.MinPoint.X)'+(1.27)
	oPlaceY = oBorder.RangeBox.MaxPoint.Y 
	oPlacementPoint = ThisApplication.TransientGeometry.CreatePoint2d(oPlaceX,oPlaceY)
	oPartsList.Position = oPlacementPoint
	
	PartsListFitColumns(oPartslist)

End Sub

Public Function PartsListFitColumns(oPartsList As PartsList) As PartsList

	If oPartsList Is Nothing Then Exit Function

	' get font info
	Dim dWidth As Double
	dWidth = oPartsList.DataTextStyle.FontSize * oPartsList.DataTextStyle.WidthScale


	' find longest string in each column and resize column
	Dim oRow As PartsListRow
	Dim sData As String
	Dim iCol As Integer
	Dim iCols As Integer

	iCols = oPartsList.PartsListColumns.Count

	' set up array to hold column widths
	Dim iLen() As Integer
	ReDim iLen(iCols)

	' initialize to header lengths
	For iCol = 1 To iCols
		iLen(iCol) = Len(oPartsList.PartsListColumns(iCol).Title)
	Next iCol

	' loop thru each row
	For Each oRow In oPartsList.PartsListRows
		If oRow.Visible = True Then
			For iCol = 1 To iCols
				sData = oRow.Item(iCol).Value ' get the data from the cell
				
				If Len(sData) > iLen(iCol) Then
					iLen(iCol) = Len(sData)
				End If
			Next iCol
		End If
	Next oRow

	' resize the columns (note add extra 2 character width for padding)
	For iCol = 1 To iCols
		oPartsList.PartsListColumns(iCol).Width = dWidth * (iLen(iCol) + 2) / 1.3
	Next iCol

	Return oPartsList
End Function

[GosponZ · Accepted solution]

Randy,

 thank you very much. It is working perfect. I uncomment input list box and that is all i need.