All,
I'm wondering if you can help me. I'm using the code below in an Assembly to export the Mass and COG Position data of all sub-assemblies to an XLSX spreadsheet.
I got the code using this post, which was very helpful as there is precious little info on the internet about this.
I'd like to also export data for parts (not just sub-assemblies). Does anyone know how I could update the code to include that?
I'm using Inventor Professional 2022, Build: 350, Release: 2022.3.
My code is as follows:
Class ThisRule
Public i As Long
Sub Main()
Dim oAssDoc As AssemblyDocument
oAssDoc = ThisApplication.ActiveDocument
Dim oCompDef As AssemblyComponentDefinition
oCompDef = oAssDoc.ComponentDefinition
Dim oOcc As ComponentOccurrence
Dim strExcelPath As String
strExcelPath = "C:\path to excel file here" 'Please create one excel file before running the code, and define the location of excel here
oExcelApp = GoExcel.Application
GoExcel.CellValue(strExcelPath, "Sheet1", "A1")= "Sub-Assembly Name"
GoExcel.CellValue(strExcelPath, "Sheet1", "B1")= "X"
GoExcel.CellValue(strExcelPath, "Sheet1", "C1")= "Y"
GoExcel.CellValue(strExcelPath, "Sheet1", "D1")= "Z"
i=2
For Each oOcc In oCompDef.Occurrences
Call GetCOG(oOcc,strExcelPath)
Next
GoExcel.Save
GoExcel.Close
End Sub
Function GetCOG(oOcc As ComponentOccurrence, s as String)
If oOcc.DefinitionDocumentType = kAssemblyDocumentObject Then
Dim oMassProps As MassProperties
Dim oAsmbDoc As AssemblyDocument
oAsmbDoc = oOcc.Definition.Document
oMassProps = oAsmbDoc.ComponentDefinition.MassProperties
GoExcel.CellValue(s, "Sheet1", "A" & CStr(i))= oOcc.Name
GoExcel.CellValue(s, "Sheet1", "B" & CStr(i))= oMassProps.CenterOfMass.X
GoExcel.CellValue(s, "Sheet1", "C" & CStr(i))= oMassProps.CenterOfMass.Y
GoExcel.CellValue(s, "Sheet1", "D" & CStr(i))= oMassProps.CenterOfMass.Z
i=i+1
End If
If oOcc.SubOccurrences.Count > 0 Then
For Each oOcc In oOcc.SubOccurrences
Call GetCOG(oOcc,s)
Next
End If
End Function
End Class
Many thanks,
Tom
Solved! Go to Solution.
Solved by tom.allison. Go to Solution.
You need to remove assembly document check (and appropriate End If)
If oOcc.DefinitionDocumentType = kAssemblyDocumentObject Then
and remove explicit type at
Dim oAsmbDoc 'As AssemblyDocument
Thanks Michael,
If I remove the line below I get errors, I think because the line that defines oMassProps uses oAsmbDoc.
Dim oAsmbDoc 'As AssemblyDocument
Should I change the line above to define oAsmbDoc as a generic document type? Is that possible?
Many thanks,
Tom
All
In case it helps anyone reading this in future I managed to solve this.
I used the existing If statement in the GetCOG() function in the code in my original post to export mass properties of sub assemblies, then added a very similar ElseIf statement to it to export mass properties of parts.
This code works fine with smaller, error-free, well assembled and modelled assemblies, but I'm having problems with some large assemblies but I think that has more to do with their huge size and the quality of their structure (some have errors in, etc.).
My working code is as follows:
Class ThisRule
Public i As Long
Sub Main()
Dim oAssDoc As AssemblyDocument
oAssDoc = ThisApplication.ActiveDocument
Dim oCompDef As AssemblyComponentDefinition
oCompDef = oAssDoc.ComponentDefinition
Dim oOcc As ComponentOccurrence
Dim strExcelPath As String
strExcelPath = "C:/path to xlsx file here.xlsx" 'Please create one excel file before running the code, and define the location of excel here
oExcelApp = GoExcel.Application
GoExcel.CellValue(strExcelPath, "Sheet1", "A1") = "Sub-Assembly Name"
GoExcel.CellValue(strExcelPath, "Sheet1", "B1") = "Mass"
GoExcel.CellValue(strExcelPath, "Sheet1", "C1") = "X"
GoExcel.CellValue(strExcelPath, "Sheet1", "D1") = "Y"
GoExcel.CellValue(strExcelPath, "Sheet1", "E1") = "Z"
i=2
For Each oOcc In oCompDef.Occurrences
Call GetCOG(oOcc,strExcelPath)
Next
GoExcel.Save
GoExcel.Close
End Sub
Function GetCOG(oOcc As ComponentOccurrence, s as String)
If oOcc.DefinitionDocumentType = kPartDocumentObject Then
Dim oMassProps As MassProperties
Dim oAsmbDoc As PartDocument
oAsmbDoc = oOcc.Definition.Document
oMassProps = oAsmbDoc.ComponentDefinition.MassProperties
GoExcel.CellValue(s, "Sheet1", "A" & CStr(i))= oOcc.Name
GoExcel.CellValue(s, "Sheet1", "B" & CStr(i))= oMassProps.Mass
GoExcel.CellValue(s, "Sheet1", "C" & CStr(i))= oMassProps.CenterOfMass.X
GoExcel.CellValue(s, "Sheet1", "D" & CStr(i))= oMassProps.CenterOfMass.Y
GoExcel.CellValue(s, "Sheet1", "E" & CStr(i))= oMassProps.CenterOfMass.Z
i=i+1
ElseIf oOcc.DefinitionDocumentType = kAssemblyDocumentObject Then
Dim oMassProps As MassProperties
Dim oAsmbDoc As AssemblyDocument
oAsmbDoc = oOcc.Definition.Document
oMassProps = oAsmbDoc.ComponentDefinition.MassProperties
GoExcel.CellValue(s, "Sheet1", "A" & CStr(i))= oOcc.Name
GoExcel.CellValue(s, "Sheet1", "B" & CStr(i))= oMassProps.Mass
GoExcel.CellValue(s, "Sheet1", "C" & CStr(i))= oMassProps.CenterOfMass.X
GoExcel.CellValue(s, "Sheet1", "D" & CStr(i))= oMassProps.CenterOfMass.Y
GoExcel.CellValue(s, "Sheet1", "E" & CStr(i))= oMassProps.CenterOfMass.Z
i=i+1
End If
If oOcc.SubOccurrences.Count > 0 Then
For Each oOcc In oOcc.SubOccurrences
Call GetCOG(oOcc,s)
Next
End If
End Function
End Class
Thanks,
Tom
Can't find what you're looking for? Ask the community or share your knowledge.