Merge parts in BOM

[m.maertens6DTZT]

Hello,

I’m struggling with the parts list.

The goal is: Merging 2 different parts together, and reset the amount of pcs into a set.

So,

I have 2 different parts (A.ipt and B.ipt) with the same properties. ( same part nr, description..)

The 2 parts are physically the same, but in 3D we have a stand alone and a build-in version.

When I generate a drawing with parts list (BOM), then I want to have these 2 parts merged together.

The amount of these 2 parts must be counted together, and then divided into a SET. (1 set = 8 pcs)

I have the code to set the new quantity into a set of 8.

See below:

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

But now I want to add the code that merge the 2 .ipt files into 1 amount.

The tricky part is that we can have 3 different assemblies:

• Only parts A.ipt
• Only parts B.ipt
• Parts A.ipt and B.ipt ( in this case I want to merge A and B together)

 Maybe something like this:

            If sQtypartA > sQtypartB Then
                sNewQty = sQtypartA
                Else
                sNewQty =  sQtypartB
            End If
            
            If sBOMRowpartA <> 0 And sBOMRowpartB <> 0 Then 
                Set oBOMRow = oBOMView.BOMRows.Item(sBOMRowpartA)
                oBOMRow.TotalQuantity = 0
                Set oBOMRow = oBOMView.BOMRows.Item(sBOMRowpartB)
                oBOMRow.TotalQuantity = sNewQty
            End If
            
            If sBOMRopartA = 0 And sBOMRowpartB <> 0 Then 
                Set oBOMRow = oBOMView.BOMRows.Item(sBOMRowpartB)
                oBOMRow.TotalQuantity = sNewQty
            End If
            
            If sBOMRowpartA <> 0 And sBOMRowpartB = 0 Then 
                Set oBOMRow = oBOMView.BOMRows.Item(sBOMRowpartA)
                oBOMRow.TotalQuantity = sNewQty
            End If

Can someone please help me out with the code?

Thanks!

Best regards,

Maarten

[bshbsh]

Can't you achieve this in the model BOM with automatic merge of rows, and base units?

[m.maertens6DTZT]

I thought that this function could have issues with a frame generator.

[bshbsh]

Did you mention frame generator?

[m.maertens6DTZT]

Yes,

A collegue told me that they didn't used the function, because then they had issues with frame generator. 
Because when we create frames with the frame generator, then we must see all the profiles separately and not merged.

[chandra.shekar.g]

@m.maertens6DTZT,

Try below VBA code to merge 2 part. Before running code, PartsList look like below.

Sub Main()

    Dim oDoc As DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument
    
    Dim oSheet As Sheet
    Set oSheet = oDoc.ActiveSheet
    
    Dim oPartsList As PartsList
    Set oPartsList = oSheet.PartsLists.Item(1)
    
    Dim name_A As String
    name_A = "Part A"
    Dim name_B As String
    name_B = "Part B"
    
    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.Item("PART NUMBER").Value = name_A Then
            Set oRowPartA = oRow
            sQtypartA = oRowPartA.Item("QTY").Value / 8
        ElseIf oRow.Item("PART NUMBER").Value = name_B Then
            Set oRowPartB = oRow
            sQtypartB = oRowPartB.Item("QTY").Value / 8
        End If
    Next
    
    If sQtypartA > sQtypartB Then
        sNewQty = sQtypartA
    Else
        sNewQty = sQtypartB
    End If
    
    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
    
End Sub

After running code, PartsList look like below.

Thanks and regards,

[m.maertens6DTZT]

Hello,

Many thanks for your effort.

We're on good track, but it doesn't exactly works like it should.

I have a question regarding the names.

Dim name_A As String

name_A = "Part A"

"Part A" : That is the filename, correct?

"name_A": that can be whatever?

Dim oRowPartA As PartsListRow

--> PartA: that is still the same filename without spaces?  Or is that the "Part Number" that is mentioned in the iproperties

ElseIf oRow.Item("PART NUMBER").Value = name_B Then Set oRowPartB = oRow

- name_B: that is the name of the string, the iproperties or the filename.

- oRowPartB : PartB is the name of the file?

Because,

I have 2 different filenames : "Part A" and "Part B" , but they both have the same Part Number in the iProperties and also having the same Description.

I just want to be sure that I use the correct names in the code.

Thanks

[chandra.shekar.g]

@m.maertens6DTZT,

Hoping that below VBA code would help to merge PartsList based on part file names.

Sub Main()

    Dim oDoc As DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument
    
    Dim oSheet As Sheet
    Set oSheet = oDoc.ActiveSheet
    
    Dim oPartsList As PartsList
    Set oPartsList = oSheet.PartsLists.Item(1)
    
    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
    
    If sQtypartA > sQtypartB Then
        sNewQty = sQtypartA
    Else
        sNewQty = sQtypartB
    End If
    
    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
    
End Sub

Please feel free to contact if there is any queries.

If solves problem, click on "Accept as solution" / give a "Like".

Thanks and regards,

[m.maertens6DTZT]

Thanks!
I will try this today.
Just one question, when you mentioned Dim oRowPartA As PartsListRow
The 'PartA', is that the same name as the .ipt file, but without spaces?

Thanks

[chandra.shekar.g]

@m.maertens6DTZT,

Yes, That's right!! it is completely file name with extension. You  can rename it as per name that are using. But don't forget to put extension along with that.

Thanks and regards,

[m.maertens6DTZT]

Hello,

This code doesn't apply for our application.

If sQtypartA > sQtypartB Then sNewQty = sQtypartA Else sNewQty = sQtypartB

If both parts are in the assembly, then we need to count them up and then divide them into 8.

So, one part is then zero and the other part is the sum of both/8.

It's not easy to explain, but I hope you understand this now?

Or maybe you need to have our 3D parts?

Thanks anyway

[chandra.shekar.g · Accepted solution]

@m.maertens6DTZT,

Hope this helps.

Sub Main()

    Dim oDoc As DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument
    
    Dim oSheet As Sheet
    Set oSheet = oDoc.ActiveSheet
    
    Dim oPartsList As PartsList
    Set oPartsList = oSheet.PartsLists.Item(1)
    
    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
    
End Sub

Thanks and regards,

[m.maertens6DTZT]

Hello,

This works now! Thanks a lot. I really appreciate your help.

I just added the roundup to have thing right in my BOM.

--> sQtyPartA = RoundUp(oRowPartA.Item("QTY").Value / 8)

Thanks a lot

Best regards,