Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
MechMachineMan
in reply to: bespel

I commented and bolded the things you need to change so that you can get some solid practice learning it for yourself in the case that you don't luck out and get a freebie by someone else doing it for you (or decide to pay for someone to do it otherwise).

 

Let us know if you get caught on anything and we can help from there.

 

The logical flow is all done, so you just need to convert it to code.

 

Good luck

 

 

Sub Main
    Dim oDoc As AssemblyDocument
    oDoc = ThisApplication.ActiveDocument
    
    ' Set a reference to the BOM
    Dim oBOM As BOM
    oBOM = oDoc.ComponentDefinition.BOM
    
'remove structured view stuff oBOM.StructuredViewFirstLevelOnly = False oBOM.StructuredViewEnabled = True 'Set a reference to the "Structured" BOMView Dim oBOMView As BOMView
'replace to Parts Only BOM View oBOMView = oBOM.BOMViews.item("Structured")
'rename dictionary to 'Materials' and replace references to 'Colors' with 'Materials' Dim Colors As Object Colors = CreateObject("Scripting.Dictionary")
'replace with matching sub/function name as below (and proper arguments here)
'see above note about colors...
Call PaintRecurse(oBOMView.BOMRows, Colors)
'see above note....
'ensure that this spits out the proper string
'convert it to adding the string value to a custom iproperty instead of to a msgbox.
For Each item In Colors msg = "Paint: " & item & " Area: " & Colors(item) & " cm^2" & Iif(msg <> "",vbCrLf & msg,"") Next MsgBox(msg) End Sub
'rename to BOMweightIteration 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)
'grab material name from comp def

'Change this if statement to a check to see if the part material exists in the dictionary If (oCompDef.Document.DocumentType = kPartDocumentObject) Then

'If it does
'add the weight of the line to the weight of the material in the library
'if it doesn't
'add the weight and material name of the line to the dictionary


'remove face stuff as it's irrelevant 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
'PartsOnly is flat, so remove recursion... 'Recursively iterate child rows if present. If Not oRow.ChildRows Is Nothing Then Call PaintRecurse(oRow.ChildRows, Colors, oRow.ItemQuantity * SubQty) Next End Sub 

 


--------------------------------------
Did you find this reply helpful ? If so please use the 'Accept as Solution' or 'Like' button below.

Justin K
Inventor 2018.2.3, Build 227 | Excel 2013+ VBA
ERP/CAD Communication | Custom Scripting
Machine Design | Process Optimization


iLogic/Inventor API: Autodesk Online Help | API Shortcut In Google Chrome | iLogic API Documentation
Vb.Net/VBA Programming: MSDN | Stackoverflow | Excel Object Model
Inventor API/VBA/Vb.Net Learning Resources: Forum Thread

Sample Solutions:Debugging in iLogic ( and Batch PDF Export Sample ) | API HasSaveCopyAs Issues |
BOM Export & Column Reorder | Reorient Skewed Part | Add Internal Profile Dogbones |
Run iLogic From VBA | Batch File Renaming| Continuous Pick/Rename Objects

Local Help: %PUBLIC%\Documents\Autodesk\Inventor 2018\Local Help

Ideas: Dockable/Customizable Property Browser | Section Line API/Thread Feature in Assembly/PartsList API Static Cells | Fourth BOM Type