Parts list in a drawing. How to merge two parts and manipulate the quantity

[m.maertens6DTZT]

Hi guys,

In the BOM of the drawing, I want to merge + manipulate the quantity of two parts in an assembly.

1. Merge the 2 parts. We have two different parts but with the same part nr. These 2 parts needs to be merged with each other. (in real, these parts are identical, but in 3D we need to draw them in a different way. That's why we have 2 different parts)

1. Manipulate the quantity because the parts are in a set of 8 pieces. And I want to see the amount of a SET – not of the parts separately.

Can somebody help me how I can Merge the 2 parts – in VBA code please?

I have already the code to change the amount of the parts in a set of 8

   '200 00 08
        Case InStr(oBOMView.BOMRows.Item(j).ReferencedFileDescriptor.ReferencedFile.FullFileName, "200 00 00")
                sNewQty = RoundUp(oBOMView.BOMRows.Item(j).TotalQuantity / 8)
                oBOMView.BOMRows.Item(j).TotalQuantity = sNewQty

Thanks!

Best regards,

Maarten

[chandra.shekar.g · Accepted solution]

@m.maertens6DTZT,

I think, same question is answered in below forum discussion.

https://forums.autodesk.com/t5/inventor-customization/merge-parts-in-bom/m-p/7990091/highlight/false...

Thanks and regards,

[m.maertens6DTZT]

Hi,

This code works, but I want to do this for all the drawing sheets that are having a parts list.

How do I need to loop trough all sheets?

Thanks

[m.maertens6DTZT]

Hi,

This code works, but I want to do this for all the drawing sheets that are having a parts list.

How do I need to loop trough all sheets?

Thanks

[chandra.shekar.g]

@m.maertens6DTZT,

Hoping that below code to check partslists in all drawing sheets.

Sub Main()
    Dim oDoc As DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument
    
    Dim oSheet As Sheet
    For Each oSheet In oDoc.Sheets
        Dim oPartsList As PartsList
        For Each oPartsList In oSheet.PartsLists
            Dim name_A As String
            name_A = "Part A.ipt"
            Dim name_B As String
            name_B = "Part B.ipt"
           
            Dim oRowPartA As PartsListRow
            Dim oRowPartB As PartsListRow
            Dim oRow As PartsListRow
            Dim sQtypartA As Integer
            sQtypartA = 0
            Dim sQtypartB As Integer
            sQtypartB = 0
            Dim sNewQty  As Integer
            sNewQty = 0
            For Each oRow In oPartsList.PartsListRows
                If oRow.ReferencedFiles.Item(1).DisplayName = name_A Then
                    Set oRowPartA = oRow
                    sQtypartA = oRowPartA.Item("QTY").Value / 8
                ElseIf oRow.ReferencedFiles.Item(1).DisplayName = name_B Then
                    Set oRowPartB = oRow
                    sQtypartB = oRowPartB.Item("QTY").Value / 8
                End If
            Next
        
            sNewQty = sQtypartA + sQtypartB   
           
            If Not oRowPartA Is Nothing And Not oRowPartB Is Nothing Then
                oRowPartA.Item("QTY").Value = 0
                oRowPartB.Item("QTY").Value = sNewQty
            End If
           
            If oRowPartA Is Nothing And Not oRowPartB Is Nothing Then
                oRowPartB.Item("QTY").Value = sNewQty
            End If
           
            If Not oRowPartA Is Nothing And oRowPartB Is Nothing Then
                oRowPartA.Item("QTY").Value = sNewQty
            End If
        Next
    Next  
   
End Sub

Thanks and regards,

[m.maertens6DTZT]

Hi chandra.shekar.g

Thanks for your help. 

When I'm running the code, that it works for every sheet, but not as it should be.

It reduces now all quantities to zero. ( It's like it keeps reducing the amount till zero)

When I use the previous code on that sheet, it works as it should be.

[chandra.shekar.g]

@m.maertens6DTZT,

Can you please share drawing document to test and also share expected result? Please makes sure that files are non confidential.

Thanks and regards,

[m.maertens6DTZT]

Hi,
It works now.
Thanks!

[chandra.shekar.g · Accepted solution]

@m.maertens6DTZT,

If it is working, click on "ACCEPT SOLUTION".

Thanks and regards,