auto fit columns in parts list

auto fit columns in parts list

cadman777
Advisor Advisor
5,972 Views
56 Replies
Message 1 of 57

auto fit columns in parts list

cadman777
Advisor
Advisor

Hello All,

I just got through searching this forum for some code that 'auto fits columns in the drawing parts list'.

I found 2 threads, but they're very old and don't have what I need.

Does anybody have any code they can share w/me?
My idea, based on what I found, is to count all the characters in all the lines in each column, then widen that column by the longest string + whatever additional characters the user specifies in the code.

Does that sound like it's reasonable and do-able?

Thanx ...

... Chris
Win 7 Pro 64 bit + IV 2010 Suite
ASUS X79 Deluxe
Intel i7 3820 4.4 O/C
64 Gig ADATA RAM
Nvidia Quadro M5000 8 Gig
3d Connexion Space Navigator
0 Likes
Accepted solutions (1)
5,973 Views
56 Replies
Replies (56)
Message 21 of 57

marcin_otręba
Advisor
Advisor

I modified code to work woithout selecting the partslist, also simplified little bit:

 

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
	For Each oSheet In oDrawDoc.Sheets
	For Each oPL As PartsList In oSheet.PartsLists
		PartsListFitColumns(oPL)
	Next
	Next
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)
		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
		If oPartsList.PartsListColumns(iCol).Width <> dWidth * (iLen(iCol) + 2) / 1.3 Then
			oPartsList.PartsListColumns(iCol).Width = dWidth * (iLen(iCol) + 2) / 1.3
		End If
	Next iCol
	Return oPartsList
End Function

 if you want to run it step by step you can do it from vba editor using step debug (F8 key) you can use this vba code:

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
    Set oDrawDoc = ThisApplication.ActiveDocument
    Dim oSheet As Sheet
    Dim oPL As PartsList
    For Each oSheet In oDrawDoc.Sheets
    For Each oPL In oSheet.PartsLists
        PartsListFitColumns oPL
    Next
    Next
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)
        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
        If oPartsList.PartsListColumns(iCol).Width <> dWidth * (iLen(iCol) + 2) / 1.3 Then
            oPartsList.PartsListColumns(iCol).Width = dWidth * (iLen(iCol) + 2) / 1.3
        End If
    Next iCol
    
End Function

 

Hi, maybe you want to check my apps:


DrawingTools   View&ColoringTools   MRUFolders

Message 22 of 57

cadman777
Advisor
Advisor

Marcin,

Excellent! Thanx!

Let me try it and see how it works.

I wanna check it out in VBA w/F8.

Best way to learn.

Cheers!

... Chris
Win 7 Pro 64 bit + IV 2010 Suite
ASUS X79 Deluxe
Intel i7 3820 4.4 O/C
64 Gig ADATA RAM
Nvidia Quadro M5000 8 Gig
3d Connexion Space Navigator
0 Likes
Message 23 of 57

cadman777
Advisor
Advisor

Marcin,

I ran this macro.

It works!

There's only one caveat:

The % factor increase/decrease code widens the long lines too much, and if I change the numbers to make the long lines fit properly, the code narrows the short lines too much.

Is there an Object that works on the basis of the line length and not a % factor?

Cheers ...

... Chris
Win 7 Pro 64 bit + IV 2010 Suite
ASUS X79 Deluxe
Intel i7 3820 4.4 O/C
64 Gig ADATA RAM
Nvidia Quadro M5000 8 Gig
3d Connexion Space Navigator
0 Likes
Message 24 of 57

marcin_otręba
Advisor
Advisor

you can try somethiing like this:

 

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
    Dim oPL As PartsList
    For Each oSheet In oDrawDoc.Sheets
    For Each oPL In oSheet.PartsLists
        PartsListFitColumns (oPL)
    Next
    Next
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
	MessageBox.Show(dWidth, "Title")

    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
		If iLen(iCol)<=10 Then
	        If oPartsList.PartsListColumns(iCol).Width <> dWidth * (iLen(iCol))  Then
	            oPartsList.PartsListColumns(iCol).Width = dWidth * (iLen(iCol)) 
	        End If
		End If
		If iLen(iCol)>10 And iLen(iCol)<=20 Then
	        If oPartsList.PartsListColumns(iCol).Width <> 0.85*dWidth * (iLen(iCol))  Then
	            oPartsList.PartsListColumns(iCol).Width = 0.85*dWidth * (iLen(iCol)) 
	        End If
		End If
		If iLen(iCol)>20 Then
	        If oPartsList.PartsListColumns(iCol).Width <> 0.7*dWidth * (iLen(iCol))  Then
	            oPartsList.PartsListColumns(iCol).Width = 0.7*dWidth * (iLen(iCol)) 
	        End If
		End If
    Next iCol
    
End Function

Hi, maybe you want to check my apps:


DrawingTools   View&ColoringTools   MRUFolders

Message 25 of 57

cadman777
Advisor
Advisor

Thanx for the new code Marcin!

I see what you did ... you segmented widths into groups (you narrowed the scope of the % increase so the discrepancies in width are not that 'bad'). Great idea!

I will test it out later (and adjust the new code as needed), and let you know how it works.

Thanx again!

... Chris
Win 7 Pro 64 bit + IV 2010 Suite
ASUS X79 Deluxe
Intel i7 3820 4.4 O/C
64 Gig ADATA RAM
Nvidia Quadro M5000 8 Gig
3d Connexion Space Navigator
0 Likes
Message 26 of 57

cadman777
Advisor
Advisor

Hi Marcin,

I finally got time to test this macro.

It works much better than the first one.

However, there are some issues with it b/c it doesn't resize some columns properly.

I read in one post that the ColumnWidth Object and Methods were designed to work on MONOSPACE text.

So I think the problem is when using any other text, there's no way to accurately measure the length of the row.

If that is correct, then reason would dictate that in order to accurately measure the row length, the macro would need to measure the width of every single letter in the row, and then add them all up. But that means the software would need to have a way to measure each and every letter of each and every font type, and the software would also need to be able to identify which font type is being used. And then, instead of increasing the width by a % or scale factor (which is very inaccurate), there would need to be a way to add one or two spaces to the length of the line.

Does that make sense to you?

So this SIMPLE REQUEST appears to be a very complex coding challenge, due to the apparent lack of Controls built into the software. I sure hope I'm wrong!

What do you think?

... Chris
Win 7 Pro 64 bit + IV 2010 Suite
ASUS X79 Deluxe
Intel i7 3820 4.4 O/C
64 Gig ADATA RAM
Nvidia Quadro M5000 8 Gig
3d Connexion Space Navigator
0 Likes
Message 27 of 57

marcin_otręba
Advisor
Advisor

hi,

 

sorry but i think that it is not possible to get better results. I tried with

System.Windows.Forms.TextRenderer.MeasureText

and results were similar.

You can always try to decrease width and check row height if did not change thane decrease little bit more till it will not be extended (row height)

but i would stay with that what you got right now.

Hi, maybe you want to check my apps:


DrawingTools   View&ColoringTools   MRUFolders

0 Likes
Message 28 of 57

cadman777
Advisor
Advisor

Hi Marcin,

 

Thanx for 'going the extra mile' w/this.

I really appreciate it!

 

I looked up what this means "TextRenderer.MeasureText"

https://docs.microsoft.com/en-us/dotnet/api/system.windows.forms.textrenderer.measuretext?view=netco... 

It appears to measure in PIXELS, not in standard units.

Maybe that's the problem?

 

Anyway, at this point I see 2 options, since Autodesk REFUSES to make an Object w/Methods to address this:

1. I can make a matrix out of your code process that functions at increments of 1 or 2 or 3 instead of 10.

    Then 'scale' the results of each increment and test it out to see how it works to arrive at the correct relative median scale that brings the best results.

OR (tell me what you think of this):

2. I can get a font editing program and open the font type that I use along with the MONOTEXT font, and measure the width of each letter in both font types to see what the difference is. Then code would need to be written to first identify the font type used. Then identify each and every letter in each and every line, added-up all the letters in each line to determine a line length. Then the longest line would be used and a space or two would be added to increase the length slightly so the text won't be right up against the vertical border of the PartsList. The only thing that I'm not sure of is what happens if underscore or italics is used w/the font. That may complicate things, but I doubt it, b/c I've never seen either underscores or italics in PartsLists.

What do you think of that idea?

Do you think it'll work?

 

... Chris
Win 7 Pro 64 bit + IV 2010 Suite
ASUS X79 Deluxe
Intel i7 3820 4.4 O/C
64 Gig ADATA RAM
Nvidia Quadro M5000 8 Gig
3d Connexion Space Navigator
0 Likes
Message 29 of 57

marcin_otręba
Advisor
Advisor

to be honest to me it is not worth the effort. I think it is possible when you consider one or two possibble fonts, but in general it will be pain in the ass to get better result than option 1.

But maybe from self-development point of view it will not be compleatly wasted time.

Hi, maybe you want to check my apps:


DrawingTools   View&ColoringTools   MRUFolders

0 Likes
Message 30 of 57

cadman777
Advisor
Advisor

Sounds reasonable to me.

That's why I made my 'dig' at Autodesk (for their gross negligence in developing Inventor on, for example, this one defect).

Sizing PartsList columns is one of the most frequently done things when making drawings.

For example: Let's say you have 3 PartsLists on average per drawing, and you have a 50 sheet drawing packet.

That's quite a substantial waste of time, culling through every file and sheet inspecting them to see which columns need resizing, and then resizing them. MANUALLY. It's even worse when you have to do it every time there's a change in the 3D model, which occurs often when working w/customer's requests (something I'm very familiar with), esp. when the changes occur at the very end of the project(!) when some middle-management bureaucrat 'changes their mind' after all the drawings are completed and signed-off on.

I remember when using Release 8 that we clamored for auto-sizing columns.
If memory serves, Release 9 worked that way, but we lost it in version 2010.

It's a YOYO! OR ...  maybe it's a majik act: 'Now you see it, now you don't!'

 

Anyways, thanx for all your expert help.

Much appreciated!

... Chris
Win 7 Pro 64 bit + IV 2010 Suite
ASUS X79 Deluxe
Intel i7 3820 4.4 O/C
64 Gig ADATA RAM
Nvidia Quadro M5000 8 Gig
3d Connexion Space Navigator
0 Likes
Message 31 of 57

WCrihfield
Mentor
Mentor

This is the code I've been using. It has some similarities, but seems a lot shorter and less complicated.

It is just regular iLogic code.

It's not perfect, because of all the variations in font widths, but does what it is designed to do.

 

Dim oDDoc As DrawingDocument = ThisDrawing.Document
Dim oPList As PartsList = oDDoc.ActiveSheet.PartsLists.Item(1)
If oPList Is Nothing Then MsgBox("No oPList Recieved By Sub") : Return
Dim oCols As PartsListColumns = oPList.PartsListColumns
Dim oRows As PartsListRows = oPList.PartsListRows
Dim oRow As PartsListRow
Dim oFWidth, oCHWidth, oDWidth, oWidestData As Double
oFWidth = oPList.DataTextStyle.FontSize * oPList.DataTextStyle.WidthScale
Dim oDWidths As List(Of Double) = New List(Of Double)
For i As Integer = 1 To oCols.Count
	oCHWidth = (oFWidth * oCols.Item(i).Title.Length)
	For Each oRow In oRows
		If oRow.Visible Then
			If oRow.Item(i).Value = "" Or  oRow.Item(i).Value = vbNullString Then
				Continue For
			End If
			oDWidth = (oFWidth * (oRow.Item(i).Value.Length))
			oDWidths.Add(oDWidth)
		End If
	Next
	'You may or may not need to add a little extra to each column width for left & right side padding from grid lines
	oWidestData = MaxOfMany(oDWidths.ToArray)
	oCols.Item(i).Width = Max(oCHWidth,oWidestData)
Next

 

 

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

Also, when you have time, please review & vote for these 'Ideas' I'd like to get implemented.

  • Add more capabilities to the 'Customize' dialog box (exe. Add Tab & Add Panel) Click Here
  • Constrain & Dimension Images In Assembly Sketches & Drawing Sketches (TitleBlocks & SketchedSymbols) Click Here
  • Save Section View Status In DesignViewRepresentation (So It Can Be Used In The Drawing) Click Here
  • Add SolidBodies Folder In iLogic Rule Editor Model Tab Click Here
  • Convert All Views To Raster Before Autosave Stores To 'OldVersions' Folder Click Here
  • SetDesignViewRepresentation - Fix limitations for DrawingView of a Part Click Here
  • Create DocumentSubTypeEnum Click Here
  • Add kRevisionTag or kDrawingRevisionTag to ObjectTypeEnum Click Here

Inventor 2020 Help | Inventor Forum | Inventor Customization Forum | Inventor Ideas Forum

Wesley Crihfield

EESignature

(Not an Autodesk Employee)

0 Likes
Message 32 of 57

cadman777
Advisor
Advisor

Thanx WC, appreciate your input.

Unfortunately it didn't work.

Too many run errors.

... Chris
Win 7 Pro 64 bit + IV 2010 Suite
ASUS X79 Deluxe
Intel i7 3820 4.4 O/C
64 Gig ADATA RAM
Nvidia Quadro M5000 8 Gig
3d Connexion Space Navigator
0 Likes
Message 33 of 57

Lesoux
Advocate
Advocate

I found a better solution, in my opinion, to resolve this issue. Code is written using C# language.

 

private static void FitColumnsWidth(PartsList partsList)
{
	GeneralNote tempGeneralNote = partsList.Parent.DrawingNotes.GeneralNotes.AddFitted(InvApp.TransientGeometry.CreatePoint2d(0, 0), "", partsList.DataTextStyle);

	int colsQty = partsList.PartsListColumns.Count;
	double[] fittedTextWidthCollection = new double[colsQty];

	for (int i = 0; i < colsQty; i++)
	{
		tempGeneralNote.Text = partsList.PartsListColumns[i + 1].Title;
		fittedTextWidthCollection[i] = tempGeneralNote.FittedTextWidth;

		foreach (PartsListRow row in partsList.PartsListRows)
		{
			if (row.Visible)
			{
				tempGeneralNote.Text = row[i + 1].Value;

				if (tempGeneralNote.FittedTextWidth > fittedTextWidthCollection[i])
					fittedTextWidthCollection[i] = tempGeneralNote.FittedTextWidth;
			}
		}

		partsList.PartsListColumns[i + 1].Width = fittedTextWidthCollection[i] + partsList.DataTextStyle.FontSize;
	}

	tempGeneralNote.Delete();
}
Win10 x64
Xeon E5-1630
32 Gb RAM
Quadro K5200

Inventor 2020.3.4, Build 373
Message 34 of 57

cadman777
Advisor
Advisor

Thanx!

I have no idea what to do with C#.

I can hardly do iLogic and VBA!

Cheers...Chris

... Chris
Win 7 Pro 64 bit + IV 2010 Suite
ASUS X79 Deluxe
Intel i7 3820 4.4 O/C
64 Gig ADATA RAM
Nvidia Quadro M5000 8 Gig
3d Connexion Space Navigator
0 Likes
Message 35 of 57

A.Acheson
Mentor
Mentor

@WCrihfield 

The Last Ilogic works great. No Issues on the one I tried anyhow. Thanks

 

@cadman777  Did you get it to work that time?

If this solved a problem, please click (accept) as solution.‌‌‌‌
Or if this helped you, please, click (like)‌‌
Regards
Alan
0 Likes
Message 36 of 57

cadman777
Advisor
Advisor

I don't know how to get C# to run in Inventor.

... Chris
Win 7 Pro 64 bit + IV 2010 Suite
ASUS X79 Deluxe
Intel i7 3820 4.4 O/C
64 Gig ADATA RAM
Nvidia Quadro M5000 8 Gig
3d Connexion Space Navigator
0 Likes
Message 37 of 57

WCrihfield
Mentor
Mentor

@cadman777, @A.Acheson 

I'm not a C#.net programmer either, but I can sometimes understand it, because it is a close native to vb.net, which iLogic uses.  In C#, they state the variable's Type just before the variable's name/placeholder.  They also enclose the single or multiple lines of content within a block of code (after the initial opener line) within the "{" and "}" symbols. This is why you don't see any "End If" or "Next" statements.  Yes, is some different functionality to, but simpler stuff is often not too terribly hart to translate.

     I believe I understand the code that @Lesoux posted, and have created an iLogic (vb.net) version of it, and have tested it.  In the few tests I have put it through, it seems to work just fine, and quickly too.  I believe his code was meant to be its own standalone Sub, which could be referenced to do this as a side task, and meant to be the entire code.  This is because it is set up to receive the PartsList object as an input variable, instead of directly retrieving it from the active drawing document.  So to simplify, I left a commented out starter line that one might use for that similar purpose, but am using the "Sub Main" opener that most iLogic users are used to.

 

     If you would like to use this as a reference Sub, as it was designed:

- Un-comment the Public Sub line (may have to get rid of the 'Public' part, depending on how you are using it), then comment out the Sub Main line.

- Get rid of all the code from after the Sub opener, to (and including) the For Each oPList line.

 

     I added the document type check, getting the drawing document, and the two loops (each Sheet & each PartsList).  I also changed a few variable names to shorten them.

 

Here's my iLogic version of @Lesoux 's C# code:

'Public Sub FitColumnsWidth(oPartsList As PartsList)
Sub Main
	If ThisApplication.ActiveDocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then
		MsgBox("A Drawing Document must be active for this rule (" & iLogicVb.RuleName & ") to work. Exiting.",vbOKOnly+vbCritical, "WRONG DOCUMENT TYPE")
		Exit Sub
	End If
	Dim oDDoc As DrawingDocument = ThisDrawing.Document
	Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
	For Each oSheet As Inventor.Sheet In oDDoc.Sheets
		For Each oPList As PartsList In oSheet.PartsLists
			Dim oPPoint As Point2d = oTG.CreatePoint2d(0,0)
			Dim oTempGNote As Inventor.GeneralNote = oSheet.DrawingNotes.GeneralNotes.AddFitted(oPPoint, "", oPList.DataTextStyle)
			Dim oColQty As Integer = oPList.PartsListColumns.Count
			Dim oWidths(oColQty) As Double
			Dim i As Integer
			For i = 0 To oColQty - 1
				Dim oNext As Integer = i + 1
				oTempGNote.Text = oPList.PartsListColumns(oNext).Title
				oWidths(i) = oTempGNote.FittedTextWidth
				For Each oRow As PartsListRow In oPList.PartsListRows
					If oRow.Visible Then
						oTempGNote.Text = oRow(oNext).Value
						If oTempGNote.FittedTextWidth > oWidths(i) Then
							oWidths(i) = oTempGNote.FittedTextWidth
						End If
					End If
				Next
				oPList.PartsListColumns(oNext).Width = oWidths(i) + oPList.DataTextStyle.FontSize
			Next
			oTempGNote.Delete()
		Next
	Next
End Sub

 

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

Wesley Crihfield

EESignature

(Not an Autodesk Employee)

0 Likes
Message 38 of 57

WCrihfield
Mentor
Mentor

After closer inspection of the PartsList in my test assembly drawing, after running this rule, I did notice that it didn't truly narrow the columns as far as they could have gone, because I could still manually click and drag the column dividers to make them a little bit narrower, without causing the row contents to wrap to a new line.  So still maybe not the ultimate solution, but it does work fairly well, and is a different way of doing it.

Wesley Crihfield

EESignature

(Not an Autodesk Employee)

0 Likes
Message 39 of 57

cadman777
Advisor
Advisor

@WCrihfield 

Thanx!

Let me try it and get back to you...

... Chris
Win 7 Pro 64 bit + IV 2010 Suite
ASUS X79 Deluxe
Intel i7 3820 4.4 O/C
64 Gig ADATA RAM
Nvidia Quadro M5000 8 Gig
3d Connexion Space Navigator
0 Likes
Message 40 of 57

Lesoux
Advocate
Advocate

No big deal. Just remove FontSize from the last formula:

partsList.PartsListColumns[i + 1].Width = fittedTextWidthCollection[i];

 Since property FittedTextWidth returns the exact width of GeneralNote text, your column width will fit your text in a cell without any gap.

Win10 x64
Xeon E5-1630
32 Gb RAM
Quadro K5200

Inventor 2020.3.4, Build 373
0 Likes