How do I get Inventor to calculate and sum up painted faces in an assembly.

[Anonymous]

Hi everyone. I have a problem in Inventor. I have an assembly containing several parts, sheet metals and sub-assemblies. All in the same material - but some of the faces are coloured red for show the inside of my assembly (for the painter to see whats inside and whats outside). I need to determine the total areas of lets say all in red (RAL 2004) and all in normal steel gray. How do I get a total list with the total red square meters and total gray square meters.? I hope some of you can help. BTW Im really new to computing in Inventor Ilogic so I hope you will be pretty precise 🙂 Thanks.

[CCarreiras]

Hummmm, i don't know if it is possible, i guess not.

[Anonymous]

Hi. I find that i bit odd. The way I see it Inventor must have an unique ID for each face and thereby the properties for that face. It would then help me if Inventor cound give me a total list of all areas (1 to 400) for example and then state the dimensions (x,y,z), maybe the area (which it haves anyway) and then the RAL code of that particulary area. If so - then we could get Inventor to export this to Excel and inthere its possible to sum up the cells which contains identical information such as the RAL code. Hope you get my point. 🙂

[pball · Accepted solution]

Anything* is possible!

This should get every surface in a part. I also learned about using a dictionary in VBA, never used one before and I really like it for dynamic things like this. Probably could clean things up if I actually learned how to use them properly but proof of concept works.

Public Sub paint()
    Dim oPartDoc As PartDocument
    Set oPartDoc = ThisApplication.ActiveDocument

    Dim oFaces As Faces
    Set oFaces = oPartDoc.ComponentDefinition.SurfaceBodies(1).Faces
    
    Dim Colors As Object
    Set Colors = CreateObject("Scripting.Dictionary")
        
    Dim oFace As Face
    For Each oFace In oFaces
         Colors(oFace.Appearance.DisplayName) = Colors(oFace.Appearance.DisplayName) + oFace.Evaluator.Area
    Next
    
    For Each Item In Colors
        Debug.Print "Paint: " & Item & " Area: "; Colors(Item) & " cm^2"
    Next
End Sub

*Not really but I have scripted two things users have said were impossible so far

edit:

If you can't figure out converting this to iLogic and getting it to work in an assembly I can help out more later, but for now I hope this helps.

[mcgyvr · Accepted solution]

Here is @pball code converted to ilogic.. 

    Dim oPartDoc As PartDocument
    oPartDoc = ThisApplication.ActiveDocument

    Dim oFaces As Faces
    oFaces = oPartDoc.ComponentDefinition.SurfaceBodies(1).Faces
    
    Dim Colors As Object
    Colors = CreateObject("Scripting.Dictionary")
        
    Dim oFace As Face
    For Each oFace In oFaces
         Colors(oFace.Appearance.DisplayName) = Colors(oFace.Appearance.DisplayName) + oFace.Evaluator.Area
    Next
    
    For Each Item In Colors
	MessageBox.Show("Color: " & Item & vbLf & "Area: " &Colors(Item) & "cm^2", "Surface Area by Color")
    Next

[pball]

Here is the final assembly level iLogic code. You'll just have to figure out what you want to do with the final results.

The code is pretty straight forward and is based on using the BOM. The BOM is the only way I know of to get access to every part and its quantity. I'm quite proud of this code, it's something I probably would of never done if you hadn't of asked.

Sub Main
    Dim oDoc As AssemblyDocument
    oDoc = ThisApplication.ActiveDocument
    
    ' Set a reference to the BOM
    Dim oBOM As BOM
    oBOM = oDoc.ComponentDefinition.BOM
    
    oBOM.StructuredViewFirstLevelOnly = False
    oBOM.StructuredViewEnabled = True

    'Set a reference to the "Structured" BOMView
    Dim oBOMView As BOMView
    oBOMView = oBOM.BOMViews.item("Structured")
    
    Dim Colors As Object
    Colors = CreateObject("Scripting.Dictionary")
    
    Call PaintRecurse(oBOMView.BOMRows, Colors)
    
    For Each item In Colors
        msg = "Paint: " & item & " Area: " & Colors(item) & " cm^2" & Iif(msg <> "",vbCrLf & msg,"")
    Next
	
    MsgBox(msg)

End Sub

Private Sub PaintRecurse(oBOMRows As BOMRowsEnumerator, Colors As Object, Optional SubQty As Integer = 1)
    On Error Resume Next
    ' Iterate through the contents of the BOM Rows.
    Dim i As Long
    For i = 1 To oBOMRows.count
        ' Get the current row.
        Dim oRow As BOMRow
        oRow = oBOMRows.item(i)
  
        'Set a reference to the primary ComponentDefinition of the row
        Dim oCompDef As ComponentDefinition
        oCompDef = oRow.ComponentDefinitions.item(1)
        
        If (oCompDef.Document.DocumentType = kPartDocumentObject) Then
            Dim oFaces As Faces
            oFaces = oCompDef.SurfaceBodies(1).Faces
        
            Dim oFace As Face
            For Each oFace In oFaces
                Colors(oFace.Appearance.DisplayName) = Colors(oFace.Appearance.DisplayName) + oFace.Evaluator.Area * oRow.ItemQuantity * SubQty
            Next
        End If

        'Recursively iterate child rows if present.
        If Not oRow.ChildRows Is Nothing Then Call PaintRecurse(oRow.ChildRows, Colors, oRow.ItemQuantity * SubQty)
    Next
End Sub

[Anonymous]

Thank you so much guys. You really saved my day. Just a small thing - how do I change the units from cm^2 to m^2?

[pball]

You can just multiple the cm^2 to get m^2 like so.

msg = "Paint: " & item & " Area: " & Colors(item) * .0001 & " m^2" & Iif(msg <> "",vbCrLf & msg,"")

[Anonymous]

Arh so - that makes totally sence when you see it. Final thing. How can I get the code to export it to an excel sheet? So that material in one colum and the area in another? Once again thank you very much or your support.

[pball]

Alright this exports the info to an excel file in the same folder with the same name as the assembly you run it in.

I'm kinda jealous of iLogic since it has simple excel functions for reading and writing unlike VBA. Though there isn't a way to create a new excel with those nifty functions that I saw.

I also added a few additional remarks to help people know what's going on.

Sub Main
    Dim oDoc As AssemblyDocument
    oDoc = ThisApplication.ActiveDocument
    
    ' Set a reference to the BOM
    Dim oBOM As BOM
    oBOM = oDoc.ComponentDefinition.BOM
    
    oBOM.StructuredViewFirstLevelOnly = False
    oBOM.StructuredViewEnabled = True

    'Set a reference to the "Structured" BOMView
    Dim oBOMView As BOMView
    oBOMView = oBOM.BOMViews.item("Structured")
    
    'Create a dictionary to store paint color and area in
    Dim Colors As Object
    Colors = CreateObject("Scripting.Dictionary")
    
    'Call subroutine to calculate paint areas
    Call PaintRecurse(oBOMView.BOMRows, Colors)
    
    'Set output file name
    xls = Replace(ThisDoc.Document.fullfilename,".iam",".xlsx")

    'Check if output file exists, if not create it
    If (Dir(xls) = "") Then
	excelApp = CreateObject("Excel.Application")
	excelWorkbook = excelApp.Workbooks.Add
	excelWorkbook.SaveAs(xls)
	excelWorkbook.Close
    End If

    'Open output file for writing
    GoExcel.Open(xls, "Sheet1")
    'Add header info
    GoExcel.CellValue(xls, "Sheet1", "A1") = "Color"
    GoExcel.CellValue(xls, "Sheet1", "B1") = "Area"
	
    num = 2

    'Loop through each color and add to the excel file
    For Each item In Colors
	GoExcel.CellValue(xls, "Sheet1", "A" & num) = item 
        'Area is returned in cm^3 by default so multiply by factor to get m^3
	GoExcel.CellValue(xls, "Sheet1", "B" & num) = Colors(item) * .0001
	GoExcel.CellValue(xls, "Sheet1", "C" & num) = "m^3"
	num = num + 1
    Next

    'Save and Close excel file
    GoExcel.Save
    GoExcel.Close
	
    MsgBox("Paint colors exported to " & xls)
End Sub

Private Sub PaintRecurse(oBOMRows As BOMRowsEnumerator, Colors As Object, Optional SubQty As Integer = 1)
    On Error Resume Next
    ' Iterate through the contents of the BOM Rows.
    Dim i As Long
    For i = 1 To oBOMRows.count
        ' Get the current row.
        Dim oRow As BOMRow
        oRow = oBOMRows.item(i)
  
        'Set a reference to the primary ComponentDefinition of the row
        Dim oCompDef As ComponentDefinition
        oCompDef = oRow.ComponentDefinitions.item(1)
        
        'Checks if current item is a part, skip if not a part
        If (oCompDef.Document.DocumentType = kPartDocumentObject) Then
            'Set a reference to the faces on the current part
            Dim oFaces As Faces
            oFaces = oCompDef.SurfaceBodies(1).Faces

            'Loop through all faces of part and add the appearance and area to the dictionary
            Dim oFace As Face
            For Each oFace In oFaces
                Colors(oFace.Appearance.DisplayName) = Colors(oFace.Appearance.DisplayName) + oFace.Evaluator.Area * oRow.ItemQuantity * SubQty
            Next
        End If

        'Recursively iterate child rows if present.
        If Not oRow.ChildRows Is Nothing Then Call PaintRecurse(oRow.ChildRows, Colors, oRow.ItemQuantity * SubQty)
    Next
End Sub

[karthur1]

I was looking at this code example and I have a question.  I first ran the code with all colors the "Default" color.  It worked just fine.  I then changed one of the surfaces to "Black" and ran it again.  Now it lists the area of the "Default" surfaces as well as the area of the "Black" surfaces.

Now I removed the black surface and changed it back to the "Default" color and re-ran the code.  When I do that, the "Black" area is still listed in the excel sheet.  Is there a way to clear all the values each time it is ran?

Thanks,

Kirk

[pball]

Are you deleting the excel file between running the code? The code is only updating the excel file, so if you reduce the amount of colors previous lines would be left in the file. It should be easy enough to either delete or clear the excel file if it already exists.

[karthur1]

---

@pball wrote:

Are you deleting the excel file between running the code? The code is only updating the excel file, so if you reduce the amount of colors previous lines would be left in the file. It should be easy enough to either delete or clear the excel file if it already exists.

---

No, not deleting the excel between running the code.  It does say that the .xls file already exists....overwrite?( Y/N).

I just thought that when it recreated the .xls file, that it would be a new file without the old colors left behind.

[Anonymous · Accepted solution]

I have a slightly different approach to this problem. I've written an iLogic utility that will calculate the painted area of an assembly. The general problem is that surface area of an assembly includes all faces - see example here: https://clintbrownblog.files.wordpress.com/2019/09/40clintbrown3d-autodesk-inventor-assembly-surface...

My iLogic utility creates a shrinkwrap of the assembly, does the surface area calc and then deletes the shrinkwrap. Surface area calcs are saved to iProperties in both mm3 and cm3

https://clintbrown.co.uk/2019/09/28/assembly-surface-areas-for-paint-or-coatings/

[johnsonshiue]

Hi Guys,

Or, you can check out similar tools at Inventor App store.

https://apps.autodesk.com/INVNTOR/en/List/Search?isAppSearch=True&searchboxstore=INVNTOR&facet=&coll...

Many thanks!