topic Re: Parts List Column Fitting in Inventor Programming Forum

Parts List Column Fitting

harvey3ELEA — Wed, 04 Dec 2024 14:27:24 GMT

I've been using this handy little code (from this forum) for condensing column widths of my various parts lists in my 10-sheet drawing. Code works great as it updates all 10 sheets at one time, but I'm looking to modify the code as to where it will do the column update on the current sheet (of the 10) I'm working on.

I'm not super skilled at iLogic so I'm not sure which command(s) I would need to change to accomplish the single sheet column update. Suggestions welcomed!

Sub Main()
	If Not ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
		MessageBox.Show("Hey the rule only runs in drawing documents!")
		Exit Sub
	End If
	
	Dim oDrawDoc As DrawingDocument
	oDrawDoc = ThisApplication.ActiveDocument
	Dim oSheet As Sheet
	'Create sheet counter variable
	Dim iSheetCount As Integer
	iSheetCount = 0
	Dim oProgressBar As Inventor.ProgressBar

	'Progress bar
	oMessage = "Organizing All Parts List"
	Dim SheetCount As Integer
	SheetCount = oDrawDoc.Sheets.Count
	
	oProgressBar = ThisApplication.CreateProgressBar(False, SheetCount, oMessage, True) 'True = Cancel button
	
	For Each oSheet In oDrawDoc.Sheets			
		
		For Each oPL As PartsList In oSheet.PartsLists		
			
			'Get the current sheet number
			iSheetCount = iSheetCount + 1
			
			'Update the progress bar to reflect which sheet is being operated on
			oProgressBar.Message = ("Processing Sheet " & iSheetCount & " of " & SheetCount & "...")
			oProgressBar.UpdateProgress
			
			'Sort Parts List By:
			oPL.Sort("PART #")
			oPL.Renumber
				
			'Call Sub	
			PartsListFitColumns(oPL)	
				
		Next
	
	Next
	
	oProgressBar.Close

End Sub

'Fit columns of parts list
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)
		For Each oRow In oPartsList.PartsListRows
			If oRow.Visible = True Then
					sData = oRow.Item(iCol).Value ' get the data from the cell	
					If Len(sData) > iLen(iCol) Then
						iLen(iCol) = Len(sData)
					End If
			End If
		Next oRow
		
		Dim col_l As Double = oPartsList.PartsListColumns(iCol).Width
		Dim desired_col_l = dWidth * (iLen(iCol) + 2)
		Dim ratio1 As Double = 0.85
		Dim ratio2 As Double = 0.8
		Dim ratio3 As Double = 0.75
		Dim ratio4 As Double = 0.7
		Dim ratio5 As Double = 0.62
		
		'messagebox.Show(iLen(iCol))
		
		Select Case iLen(iCol)
			Case <= 10
				If col_l <> desired_col_l * ratio1  Then
	            	oPartsList.PartsListColumns(iCol).Width = desired_col_l * ratio1
	        	End If
			Case 11 To 20
				If col_l <> desired_col_l * ratio2  Then
	            	oPartsList.PartsListColumns(iCol).Width = desired_col_l * ratio2
	        	End If
			Case 21 To 30
				If col_l <> desired_col_l * ratio3  Then
	            	oPartsList.PartsListColumns(iCol).Width = desired_col_l * ratio3
	        	End If
			Case 31 To 40
				If col_l <> desired_col_l * ratio4  Then
	            	oPartsList.PartsListColumns(iCol).Width = desired_col_l * ratio4
	        	End If
			Case >= 41
				If col_l <> desired_col_l * ratio5  Then
	            	oPartsList.PartsListColumns(iCol).Width = desired_col_l * ratio5
	        	End If
			
		End Select		
		
	Next iCol	
	
	Return oPartsList
End Function

Re: Parts List Column Fitting

Michael.Navara — Wed, 04 Dec 2024 14:41:46 GMT

This is modification of relevant part - NOT TESTED!!!

'For Each oSheet In oDrawDoc.Sheets 'Comment out Dim oSheet = oDrawDoc.ActiveSheet 'Add For Each oPL As PartsList In oSheet.PartsLists 'Get the current sheet number ' .... Keep unchanged Next ' Next 'Comment out

Re: Parts List Column Fitting

WCrihfield — Wed, 04 Dec 2024 18:15:07 GMT

Hi @harvey3ELEA. Besides what Michael already mentioned, you would likely also want to get rid of all the ProgressBar related stuff, and stuff having to do with multiple sheets, like the sheet count. I have used a different version of this same code based process for years now, but my version does not use multiple specific ratios like yours, because it did not seem to be needed in my drawings. But there are lots of possible differences in drawing styles and fonts being used, which can change how all that stuff works together, so its likely not a 'one size fits all' type situation.

Anyways, I copied your original code, then modified it in several areas, mostly to condense it and make it more efficient. But I left all the mathematical calculations so that they will work exactly the same as before, but will less code and calculations involved. Before it was doing the same calculations twice, but now just once. The original code was also obtaining the columns collection, and the one column in many different places, but now is just obtaining those once, then using that variable for all needs after that point, which will result in less processing. Give this version a try, and see if it works OK for you.

Sub Main Dim oDDoc As DrawingDocument = TryCast(ThisApplication.ActiveDocument, Inventor.DrawingDocument) If oDDoc Is Nothing Then MessageBox.Show("Hey the rule only runs in drawing documents!") Return End If For Each oPL As PartsList In oDDoc.ActiveSheet.PartsLists 'Sort Parts List By: oPL.Sort("PART #") oPL.Renumber 'Call Sub PartsListFitColumns(oPL) Next oDDoc.Update2(True) End Sub 'Fit columns of parts list Public Sub PartsListFitColumns(oPList As PartsList) If oPList Is Nothing Then Return Dim oCols As PartsListColumns = oPList.PartsListColumns ' get font info Dim dWidth As Double = oPList.DataTextStyle.FontSize * oPList.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 = oCols.Count ' Set up array To hold column widths Dim iLen() As Integer ReDim iLen(iCols) ' initialize to header lengths For iCol = 1 To iCols Dim oCol As PartsListColumn = oCols.Item(iCol) iLen(iCol) = Len(oCol.Title) For Each oRow In oPList.PartsListRows If oRow.Visible = True Then sData = oRow.Item(iCol).Value ' get the data from the cell If Len(sData) > iLen(iCol) Then iLen(iCol) = Len(sData) End If End If Next oRow Dim col_l As Double = oCol.Width Dim desired_col_l = dWidth * (iLen(iCol) + 2) Dim ScaledColW1 As Double = desired_col_l * 0.85 Dim ScaledColW2 As Double = desired_col_l * 0.8 Dim ScaledColW3 As Double = desired_col_l * 0.75 Dim ScaledColW4 As Double = desired_col_l * 0.7 Dim ScaledColW5 As Double = desired_col_l * 0.62 'messagebox.Show(iLen(iCol)) Select Case iLen(iCol) Case <= 10 If col_l <> ScaledColW1 Then oCol.Width = ScaledColW1 Case 11 To 20 If col_l <> ScaledColW2 Then oCol.Width = ScaledColW2 Case 21 To 30 If col_l <> ScaledColW3 Then oCol.Width = ScaledColW3 Case 31 To 40 If col_l <> ScaledColW4 Then oCol.Width = ScaledColW4 Case >= 41 If col_l <> ScaledColW5 Then oCol.Width = ScaledColW5 End Select Next iCol End Sub

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

Re: Parts List Column Fitting

harvey3ELEA — Wed, 04 Dec 2024 18:49:14 GMT

Thanks, Wesley. Heading out of the office a bit early, but I will give your code a run tomorrow morning and let you know how it's working. Harvey