Finding all Sheet Metal parts in Assembly

[Raider_71]

Hi I am creating a program to write out all the flat patterns of all sheet metal parts in an assy. I save it out as dxf. What I need is to totals of all the sheet metal parts across all sub assy’s etc in other words not “Structured” but “Parts Only” in Inventor BOM terms. All works fine but the only problem is that when a sub assy is a weldment or “inseparable”, it hides the parts inside it and “Parts only” BOM don’t make the internal parts of that sub available and the totals are not correct then. I need the totals because the idea is to write that into the file name including the thickness of the part.

Any idea of how to overcome this easily?

Thanks!

[skyngu]

try this, it should get all sheetmetal

' Get referenced documents from an assembly  

Dim oRefDocs As DocumentsEnumerator  

Set oRefDocs = oDoc.AllReferencedDocuments   

[Raider_71]

Thanks yes I have used that method before to get a list of all parts in an GA including subs. The only issue is it only gives me a list of parts. What about quatity? That can only be picked up from the BOM right...

[skyngu]

Purchased child components that are inside an inseparable assembly are still displayed in the parts-only parts List

can this help you?

[Raider_71]

Oh cool I didnt know that. Could come in handy at some stage. In this instance I dont think it can be used because it will mean that I will have to go through all the Weldments and change all parts to purchaced... even though they are not purchased because they are made in-house. So this will be a problem still.

I just thought there would be an easy way, but if there is not then I will have to do loads more coding to drill into the weldment subs and collect its parts and add to the quantities. (I have loads of learnign to do!)

Thanks for your help and advice!

[skyngu]

changing bom structure can be done by vb

[Raider_71]

Yes i will have to play with that and how it will work. I dont want to modify any files so will not save anything. So yes that idea could work. I must just come up with a clever routine that will go through the BOM structure and change all sub assys and sub sub assys and sub sub sub assys etc. to normal.
Hopefully then i can get to all files.

Thanks for the idea. Maybe that can be done in apprentice.

[MegaJerk]

Would something like this work ? 

(NOTE: This assumes you have a unitless parameter in your assembly called "DumbParameter")

(NOTE (2): This is a rule that will sit in your top level assembly)

Dim openDoc As Document
openDoc = ThisDoc.Document

Dim docFile As Document

If openDoc.DocumentType = 12291 Then

	Dim assemblyDoc As AssemblyDocument
	assemblyDoc = openDoc
	
	Dim assemblyDef As AssemblyComponentDefinition
	assemblyDef = assemblyDoc.ComponentDefinition
	


	Dim SMPartTotal As Integer
	SMPartTotal = 0 

	For Each docFile In openDoc.AllReferencedDocuments
		
		If docFile.DocumentType = 12290 Then
		
			Dim partDoc As PartDocument
			partDoc = ThisApplication.Documents.Open(docFile.FullFileName, False)

			Dim partQty As ComponentOccurrencesEnumerator
			partQty = assemblyDef.Occurrences.AllReferencedOccurrences(partDoc)
			
			
			
			If docFile.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then 
				
				SMPartTotal = SMPartTotal + (partQty.Count)
				
				'Else
				
				'SMPartTotal = SMPartTotal + 0
				
			End If 
		
		End If 
	
	Next
	
	DumbParameter = SMPartTotal
	
End If 

[Raider_71]

Hi thanks for the reply.

Yes that would have worked if I only needed a list of parts that are of type Sheet Metal but its a bit more complicated than that. I need a list of all Sheet Metal parts and quantities accross the whole Assy including parts thats been derived into others and also taking into consideration Weldments/Inseprable parts.

So because the quantities are important the Inventor BOM needs to be interogated to achieve this I think.

P

[brendan.henderson]

Attached is a macro I use. It was written by a friend and I have tinkered with it to suit my needs. When run on an assembly it basically does an occurence check of ALL of the sheetmetal parts and counts them. For my needs extra info like Flat Part X & Y and are and other stuff is also pulled out, and all data then populates a spreadsheet. We use this sheet as a CUT LIST for our CNC plasma cutter. Maybe you can rewrite this to suit your needs.

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Function IsApplicationRunning(ByVal sAppName) As Boolean
Dim oApp As Object
On Error Resume Next
Set oApp = GetObject(, sAppName)
If Not oApp Is Nothing Then
    Set oApp = Nothing
    IsApplicationRunning = True
End If
End Function

Sub PlasmaLatheList2()

Dim oAssDoc As AssemblyDocument
Set oAssDoc = ThisApplication.ActiveDocument

If oAssDoc.DocumentType <> kAssemblyDocumentObject Then
    MsgBox "The Active document must be an 'Assembly'!"
    Exit Sub
End If

Dim oDocs As DocumentsEnumerator
Set oDocs = oAssDoc.AllReferencedDocuments

Dim oDoc As Document

Dim row As Integer
Dim excel_app As Excel.Application

app2check = "Excel.Application"
If IsApplicationRunning(app2check) = True Then
    Set excel_app = Excel.Application
Else
    Set excel_app = CreateObject("Excel.Application")
End If

excel_app.Visible = True
excel_app.Workbooks.Add

With excel_app
    .Columns("A:A").ColumnWidth = 13
    .Range("A1").Select
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Calibri"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    .ActiveCell.FormulaR1C1 = "PLASMA CUT LIST WITH PART OPERATIONS (Part QTY shown is for 1 of the Assembly No. shown below)"
    
    .Columns("A:A").ColumnWidth = 12
    .Range("A2").Select
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Calibri"
        .Size = 12
        .Color = -6279056
        .TintAndShade = 0
    End With
    .ActiveCell.FormulaR1C1 = "Note to Plasma Operator :- All cut parts to be numbered. If *** in LATHE? column then this part needs machining so mark the part as LATHE!"
    
    .Columns("A:A").ColumnWidth = 12
    .Range("A3").Select
    Selection.Font.Bold = True
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    .ActiveCell.FormulaR1C1 = "Note to CAD operator :- if any cell in the below table (other than LATHE?) is blank then that Part needs updating. SO UPDATE IT & PRINT IT AGAIN!"
    
    .Columns("A:A").ColumnWidth = 12
    .Range("A4").Select
    Selection.Font.Bold = True
    With Selection.Font
        .Color = -11489280
        .TintAndShade = 0
    End With
    .ActiveCell.FormulaR1C1 = "Note to Estimator :- 'Flat Part X x Y (square)'is part bounding box. Part Area includes all Part drilled/tapped holes and is estimate only!"

    .Range("A6").Select
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Calibri"
        .Size = 16
    End With
    .ActiveCell.FormulaR1C1 = "ASSEMBLY No. - " & Left(oAssDoc.DisplayName, Len(oAssDoc.DisplayName) - 4)
    
    .Range("A7").Select
    .ActiveCell.FormulaR1C1 = "Part No."
    
    .Columns("B:B").ColumnWidth = 6
    .Range("B7").Select
    .ActiveCell.FormulaR1C1 = "Thick"

    .Columns("C:C").ColumnWidth = 20
    .Range("C7").Select
    .ActiveCell.FormulaR1C1 = "Material"

    .Columns("D:D").ColumnWidth = 4
    .Columns("D").HorizontalAlignment = xlHAlignLeft
    .Range("D7").Select
    .ActiveCell.FormulaR1C1 = "Qty"

    .Columns("E:E").ColumnWidth = 6
    .Range("E7").Select
    .ActiveCell.FormulaR1C1 = "Lathe?"
    
    .Columns("F:F").ColumnWidth = 53
    .Range("F7").Select
    .ActiveCell.FormulaR1C1 = "Title"
    
    .Columns("G:G").ColumnWidth = 20
    .Range("G7").Select
    .ActiveCell.FormulaR1C1 = "Operations"
    
    .Columns("H:H").ColumnWidth = 22
    .Range("H7").Select
    .ActiveCell.FormulaR1C1 = "Flat Part X x Y (square)"
        
    .Columns("I:I").ColumnWidth = 13
    .Range("I7").Select
    .ActiveCell.FormulaR1C1 = "Total Perim."
    
    .Columns("J:J").ColumnWidth = 20
    .Range("J7").Select
    .ActiveCell.FormulaR1C1 = "Flat Part Area (square)"
    
    .Columns("K:K").ColumnWidth = 6.5
    .Columns("K").HorizontalAlignment = xlHAlignLeft
    .Range("K7").Select
    .ActiveCell.FormulaR1C1 = "Pierces"
    
    .Columns("L:L").ColumnWidth = 12
    .Range("L7").Select
    .ActiveCell.FormulaR1C1 = "Cut Mass (ea)"
    
    '.Columns("M:M").ColumnWidth = 30
    '.Range("M7").Select
    '.ActiveCell.FormulaR1C1 = "Picture"
    
    .Columns("L:L").ColumnWidth = 12
    .Range("L1").Select
    .ActiveCell.FormulaR1C1 = Date
    
    .Columns("L:L").ColumnWidth = 12
    .Range("L2").Select
    .ActiveCell.FormulaR1C1 = Time
    
    
    
End With

row = 7

For Each oDoc In oDocs

    revFlag = 0

    Dim oOccs As ComponentOccurrencesEnumerator
    Set oOccs = oAssDoc.ComponentDefinition.Occurrences.AllReferencedOccurrences(oDoc)

    Dim oPropSets As PropertySets
    Set oPropSets = oDoc.PropertySets
    
    Dim oProp1 As Property
    Set oProp1 = oPropSets.Item("{32853F0F-3444-11d1-9E93-0060B03C1CA6}").ItemByPropId(kEngineerDesignTrackingProperties)
    
    Dim oProp2 As Property
    Set oProp2 = oPropSets.Item("{F29F85E0-4FF9-1068-AB91-08002B27B3D9}").ItemByPropId(kTitleSummaryInformation)
    oTitle = oProp2.Value
        
    Dim oProp3 As Property
    Set oProp3 = oPropSets.Item("{F29F85E0-4FF9-1068-AB91-08002B27B3D9}").ItemByPropId(kSubjectSummaryInformation)
    oOperations = oProp3.Value
        
    Dim oCustomPropSet As PropertySet
    Set oCustomPropSet = oDoc.PropertySets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
        
    If oDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then 'Sheet metal
        Dim oFeature As Inventor.RevolveFeature
        For Each oFeature In oDoc.ComponentDefinition.Features.RevolveFeatures
            If oFeature.Type = kRevolveFeatureObject Then
                'revFlag = 1
                oProp1.Value = "LATHE"
                Exit For
            End If
        Next

        Dim oSheetMetalCompDef As SheetMetalComponentDefinition
        Set oSheetMetalCompDef = oDoc.ComponentDefinition
        
        partThickness = oSheetMetalCompDef.Thickness.Value
        partMaterial = oSheetMetalCompDef.Material.Name
        
        partLength = oCustomPropSet.Item("SheetMetalLength").Value
        partWidth = oCustomPropSet.Item("SheetMetalWidth").Value
                    
        On Error Resume Next
            BHTotalPerimeter = oCustomPropSet.Item("TotalPerimeter").Value
            If Err Then BHOuterPerimeter = ""
            Err.Clear
            
        On Error Resume Next
            BHArea = oCustomPropSet.Item("ipwFlatArea").Value
            If Err Then BHArea = ""
            Err.Clear
            
        On Error Resume Next
            BHMass = oCustomPropSet.Item("ipwMass").Value
            If Err Then BHMass = ""
            Err.Clear
        
        On Error Resume Next
            BHPierces = oCustomPropSet.Item("Pierces").Value
            If Err Then BHPierces = 0
            Err.Clear
        
        If oOccs.count <> 0 Then
            row = row + 1
            With excel_app
                .Range("A" & Format$(row)).Select
                Selection.Font.Bold = False
                    With Selection.Font
                        .Name = "Calibri"
                        .Size = 10
                    End With
                .ActiveCell.FormulaR1C1 = Left(oDoc.DisplayName, Len(oDoc.DisplayName) - 4)
                .Range("B" & Format$(row)).Select
                Selection.Font.Bold = False
                    With Selection.Font
                        .Name = "Calibri"
                        .Size = 10
                    End With
                .ActiveCell.FormulaR1C1 = partThickness * 10 & " mm"
                .Range("C" & Format$(row)).Select
                Selection.Font.Bold = False
                    With Selection.Font
                        .Name = "Calibri"
                        .Size = 10
                    End With
                .ActiveCell.FormulaR1C1 = partMaterial
                .Range("D" & Format$(row)).Select
                Selection.Font.Bold = False
                    With Selection.Font
                        .Name = "Calibri"
                        .Size = 10
                    End With
                .ActiveCell.FormulaR1C1 = oOccs.count
                .Range("F" & Format$(row)).Select
                Selection.Font.Bold = False
                    With Selection.Font
                        .Name = "Calibri"
                        .Size = 10
                    End With
                .ActiveCell.FormulaR1C1 = oTitle
                .Range("G" & Format$(row)).Select
                Selection.Font.Bold = False
                    With Selection.Font
                        .Name = "Calibri"
                        .Size = 10
                    End With
                .ActiveCell.FormulaR1C1 = oOperations
                .Range("H" & Format$(row)).Select
                Selection.Font.Bold = False
                    With Selection.Font
                        .Name = "Calibri"
                        .Size = 10
                    End With
                .ActiveCell.FormulaR1C1 = partLength & " x " & partWidth
                .Range("I" & Format$(row)).Select
                Selection.Font.Bold = False
                    With Selection.Font
                        .Name = "Calibri"
                        .Size = 10
                    End With
                .ActiveCell.FormulaR1C1 = BHTotalPerimeter
                .Range("J" & Format$(row)).Select
                Selection.Font.Bold = False
                    With Selection.Font
                        .Name = "Calibri"
                        .Size = 10
                    End With
                .ActiveCell.FormulaR1C1 = BHArea
                .Range("K" & Format$(row)).Select
                Selection.Font.Bold = False
                    With Selection.Font
                        .Name = "Calibri"
                        .Size = 10
                    End With
                .ActiveCell.FormulaR1C1 = BHPierces
                .Range("L" & Format$(row)).Select
                Selection.Font.Bold = False
                    With Selection.Font
                        .Name = "Calibri"
                        .Size = 10
                    End With
                .ActiveCell.FormulaR1C1 = BHMass
                '.Range("M" & Format$(row)).Select
                'Selection.Font.Bold = False
                    'With Selection.Font
                        '.Name = "Calibri"
                        '.Size = 10
                    'End With
                '.ActiveCell.FormulaR1C1 = oIcon
            End With

            If StrComp(oProp1.Value, "LATHE", vbTextCompare) = 0 Then
                With excel_app
                    .Range("E" & Format$(row)).Select
                    .ActiveCell.FormulaR1C1 = "***"
                End With
            End If
        End If
    Else 'NOT sheet metal
        If StrComp(oProp1.Value, "LATHE", vbTextCompare) = 0 Then
            Set oProp = oPropSets.Item("{32853F0F-3444-11d1-9E93-0060B03C1CA6}").ItemByPropId(kMaterialDesignTrackingProperties)
            oMaterial = oProp1.Value
            row = row + 1
            With excel_app
                .Range("A" & Format$(row)).Select
                Selection.Font.Bold = False
                    With Selection.Font
                        .Name = "Calibri"
                        .Size = 10
                    End With
                .ActiveCell.FormulaR1C1 = Left(oDoc.DisplayName, Len(oDoc.DisplayName) - 4)
                .Range("C" & Format$(row)).Select
                Selection.Font.Bold = False
                    With Selection.Font
                        .Name = "Calibri"
                        .Size = 10
                    End With
                .ActiveCell.FormulaR1C1 = oMaterial
                .Range("D" & Format$(row)).Select
                Selection.Font.Bold = False
                    With Selection.Font
                        .Name = "Calibri"
                        .Size = 10
                    End With
                .ActiveCell.FormulaR1C1 = oOccs.count
                '.Range("E" & Format$(row)).Select
                '.ActiveCell.FormulaR1C1 = "***"
            End With
        End If
    End If
Next

With excel_app
    sortRange = "A8:L" & row
    .Range(sortRange).Select
    Sleep 500
    .Selection.Sort Key1:=Range("A7"), Order1:=xlAscending
    End With

With Worksheets("Sheet1").Cells
    With .FormatConditions
      .Delete
      .Add Type:=xlExpression, Formula1:="=ROW()=7"
    End With
    .FormatConditions(1).Interior.ColorIndex = 33
End With

With Worksheets("Sheet1").Cells
    N = 7
    For Each VisRow In Selection.Resize(, 1).SpecialCells(xlCellTypeVisible)
        N = N + 1
        If N Mod 2 = 0 Then
            VisRow.EntireRow.Interior.ColorIndex = 15
        End If
    Next VisRow
End With

'added by BH 12-07-2011
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
'end

'added by BH 13-07-2011
Range("A7:L7").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
'end

ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$7"
        .PrintTitleColumns = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .Orientation = xlLandscape
        .PaperSize = xlPaperA3
        .CenterFooter = "Page &P of &N"
    End With

'added by BH 11-10-2010
'ActiveSheet.PageSetup.Orientation = xlLandscape
'end

'added by BH 12-07-2011
'ActiveSheet.PageSetup.PaperSize = xlPaperA3
'end

End Sub