Centre of Gravity in Assembly

[Anonymous]

Hello everyone, 

In Inventor, a component has 2 Centre of Gravity Co-ordinates 

1. Along its own origin

2. Along the origin of the assembly in which it is placed. 

I have a code that allows me to extract the CG values in BOM for the point 1 (with respect to part origin). 

Is there any snippet or code that would allow to extract the values taking point 2 into consideration i.e. assembly specific values.

Thanks in advance

Regards

Aman

[bradeneuropeArthur]

with this

For Vba:

Public Sub main()
Dim a As Application
Set a = ThisApplication

Dim b As AssemblyDocument
Set b = a.ActiveDocument

Dim c As AssemblyComponentDefinition
Set c = b.ComponentDefinition

'c.MassProperties.CenterOfMass.X
'c.MassProperties.CenterOfMass.Y

Dim cogX As String
cogX = c.MassProperties.CenterOfMass.X
Dim cogY As String
cogY = c.MassProperties.CenterOfMass.Y

'Dim cogXprop As Property
'Dim cogXprop As Property

Call b.PropertySets.Item(4).Add(cogX, "CogX")
Call b.PropertySets.Item(4).Add(cogY, "CogY")
End Sub

 For I-Logic:

Public Sub main()
Dim a As Application
 a = ThisApplication

Dim b As AssemblyDocument
 b = a.ActiveDocument

Dim c As AssemblyComponentDefinition
 c = b.ComponentDefinition

'c.MassProperties.CenterOfMass.X
'c.MassProperties.CenterOfMass.Y

Dim cogX As String
cogX = c.MassProperties.CenterOfMass.X
Dim cogY As String
cogY = c.MassProperties.CenterOfMass.Y

'Dim cogXprop As Property
'Dim cogXprop As Property

Call b.PropertySets.Item(4).Add(cogX, "CogX")
Call b.PropertySets.Item(4).Add(cogY, "CogY")
End Sub

[Anonymous]

@bradeneuropeArthur  Firstly thanks for your response. However I was getting error in the call functions in both VBA as well as iLogics.

(Using Inventor 2017 version). 

Your code works well for the top level assembly. However, could not get it work on the sub assemblies and underlying parts in the assembly. 

I updated the code as below but still did not get any success. Could you help me where am I going wrong ?

Thanks

Public Sub Main()
Dim a As Application
 a = ThisApplication

Dim b As AssemblyDocument
 b = a.ActiveDocument

Dim c As AssemblyComponentDefinition
 c = b.ComponentDefinition

'c.MassProperties.CenterOfMass.X
'c.MassProperties.CenterOfMass.Y
Dim oOccurrence As ComponentOccurrence

For Each oOccurrence In c.Occurrences.AllReferencedOccurrences(c)

Dim cogX As String
cogX = c.MassProperties.CenterOfMass.X
Dim cogY As String
cogY = c.MassProperties.CenterOfMass.Y
Dim cogZ As String
cogZ = c.MassProperties.CenterOfMass.Z

'Dim cogXprop As Property
'Dim cogXprop As Property

'Call b.PropertySets.Item(4).Add(cogX, "CogX")
'Call b.PropertySets.Item(4).Add(cogY, "CogY")

iProperties.Value("Custom", "CG-X") = cogX
iProperties.Value("Custom", "CG-Y") = cogY
iProperties.Value("Custom", "CG-Z") = cogZ


Next
End Sub

[hendrik.koopmans]

Hey,

i used a part aof this code anbe because there was no final solution here is mine.

Public Sub Schwerpunkte(Zeile) 'Vector des Center

Dim FileName
FileName = "C:\Users\hendr\Documents\Aktuelles\Masterarbeit\VBA\GoGoGo\Datenablage.xlsx"
Dim ExcWb As Excel.Workbook
Set ExcWb = Workbooks.Open(FileName)

Dim a As Application
Set a = ThisApplication

Dim b As AssemblyDocument
Set b = a.ActiveDocument

Dim cc As AssemblyComponentDefinition
Set cc = b.ComponentDefinition

Dim oOccurrence As ComponentOccurrence
Dim cogX As Double
Dim cogY As Double
Dim cogZ As Double

For Each oOccurrence In cc.Occurrences.AllReferencedOccurrences(cc)
If oOccurrence.Name = "Nuss:1" Then
cogX = oOccurrence.MassProperties.CenterOfMass.X
cogY = oOccurrence.MassProperties.CenterOfMass.Y
cogZ = oOccurrence.MassProperties.CenterOfMass.Z

ExcWb.Worksheets(2).Cells(Zeile, 41).Value = cogX
ExcWb.Worksheets(2).Cells(Zeile, 42).Value = cogY
ExcWb.Worksheets(2).Cells(Zeile, 43).Value = cogZ

cogX = 0
cogY = 0
cogZ = 0
End If

If oOccurrence.Name = "Ratsche:10" Then
cogX = oOccurrence.MassProperties.CenterOfMass.X
cogY = oOccurrence.MassProperties.CenterOfMass.Y
cogZ = oOccurrence.MassProperties.CenterOfMass.Z

ExcWb.Worksheets(2).Cells(Zeile, 44).Value = cogX
ExcWb.Worksheets(2).Cells(Zeile, 45).Value = cogY
ExcWb.Worksheets(2).Cells(Zeile, 46).Value = cogZ

cogX = 0
cogY = 0
cogZ = 0
End If
Next
ExcWb.Save
End Sub