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!
try this, it should get all sheetmetal
' Get referenced documents from an assembly
Dim oRefDocs As DocumentsEnumerator
Set oRefDocs = oDoc.AllReferencedDocuments
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...
Purchased child components that are inside an inseparable assembly are still displayed in the parts-only parts List
can this help you?
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!
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
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
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