Create a point for center of gravity as workfeature in ipt files that contain more than one solid

[moraesorlando]

Hello Inventor experts!

I am here again with another ask for help.

I have searched in this forum and got the code below to create a point in center of gravity.

Option Explicit On

    ' Check to make sure a part or assembly document is active.
    Dim doc As Document = ThisDoc.Document
    If doc.DocumentType <> DocumentTypeEnum.kPartDocumentObject AndAlso doc.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then
        MessageBox.Show(" This rule can only be run in a part or assembly.", "WorkPoint At Mass Center")
        Exit Sub
    End If

    Dim massProps As MassProperties
    Dim workPoints As workPoints
    If (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject) Then
      Dim partDoc As PartDocument = doc
      massProps = partDoc.ComponentDefinition.MassProperties
      workPoints = partDoc.ComponentDefinition.WorkPoints
    Else
      Dim assemDoc As AssemblyDocument = doc
      massProps = assemDoc.ComponentDefinition.MassProperties
      workPoints = assemDoc.ComponentDefinition.WorkPoints
    End If

    ' Get the Center of Mass.
    Dim oCenterOfMass As Point = massProps.CenterOfMass

    ' Check to see if a work point for center of mass already exists.
    ' This uses the name of the work feature to identify it.
    Const workPointName As String = "Shipping Center Of Gravity"
    Dim oWorkPoint As WorkPoint
    Try
        oWorkPoint = workPoints.Item(workPointName)
    Catch
        oWorkPoint = Nothing
    End Try

    If (oWorkPoint IsNot Nothing) Then
        If (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject) Then
                Dim oFixedDef As FixedWorkPointDef = oWorkPoint.Definition
                oFixedDef.Point = oCenterOfMass
        Else
                Dim oFixedDef As AssemblyWorkPointDef = oWorkPoint.Definition
                oFixedDef.Point = oCenterOfMass
        End If
        doc.Update
    Else
        ' Create a new workpoint at the location of the center of mass.
        oWorkPoint = workPoints.AddFixed(oCenterOfMass)

        ' Rename the work point.
        oWorkPoint.Name = workPointName
    End If

This center of gravity point is created as workfeature and works 100% in case there is only one solid in the file.

But in my real situation I have more than one solid in the ipt file (solid1, solid2, solid3 …) and for this case, this code doesn’t work.

My goal at this moment is to get help to adapt this code to became possible to add center of gravities points in several solids, by selecting one solid each time.

My idea for this solution, would be a rule that shows a message box, asking for select which solid the center of gravity should be placed in.

I am available to provide any other information required.

Thanks in advance for all colleagues that can help.

Best regards,

[WCrihfield]

So, there apparently is not a property for CenterOfMass or CenterOfGravity for SurfaceBody objects.

The next best thing would be to find the geometric center (or centroid) of the body, if that will work for you.

I wrote one (of many) way to possibly do this.  None are likely to be absolutely perfect.

Here's one:

If ThisApplication.ActiveDocumentType <> DocumentTypeEnum.kPartDocumentObject Then
	MsgBox("This rule '" & iLogicVb.RuleName & "' only works for Part Documents.",vbOKOnly, "WRONG DOCUMENT TYPE")
	Return
End If
Dim oPDoc As PartDocument = ThisApplication.ActiveDocument
Dim oPDef As PartComponentDefinition = oPDoc.ComponentDefinition
Dim oBodies As SurfaceBodies = oPDef.SurfaceBodies
Dim oBody As SurfaceBody ' = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartBodyFilter,"Select a body.")
Dim oEdges As EdgeCollection
Dim oFace As Face, oELoop As EdgeLoop, oEdge As Edge
Dim oWP As WorkPoint
For Each oBody In oBodies
	For Each oFace In oBody.Faces
		For Each oELoop In oFace.EdgeLoops
			For Each oEdge In oELoop.Edges
				oEdges.Add(oEdge)
			Next
		Next
	Next
	oWP = oPDef.WorkPoints.AddAtCentroid(oEdges)
Next

 There must me several more ways to do this too.

[WCrihfield]

Another idea would be to use the body's 'OrientedMinimumRangeBox' Property.

Get the data from that (a corner point, and three vectors), then find its center point mathematically using that data.

[J-Camper]

Here is another way to do it.  Basically you create a temporary derived part with only 1 selected body and run the built in center of gravity to get the point.  The temporary document is discarded afterwards:

' Check to make sure a part or assembly document is active.
Dim doc As Document = ThisDoc.Document
If doc.DocumentType <> DocumentTypeEnum.kPartDocumentObject AndAlso doc.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then
    MessageBox.Show(" This rule can only be run in a part or assembly.", "WorkPoint At Mass Center")
    Exit Sub
End If
'Setup
Dim massProps As MassProperties
Dim workPoints As WorkPoints
Dim oCenterOfMass As Point
Dim workPointName As String
'Selection Type
If (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject)
	Dim partDoc As PartDocument = doc
	workPoints = partDoc.ComponentDefinition.WorkPoints
	'If Part is single solid body skip to overal
	If partDoc.ComponentDefinition.SurfaceBodies.Count = 1 Then GoTo Overall
	'Ask user to specify a body or run for overall
	If MessageBox.Show("Would you like to run the rule for the overall part?  Answering 'No' will allow user to select a solid body.", "Overall or Specify?", MessageBoxButtons.YesNo) = vbYes  
		'Overall case
Overall : massProps = partDoc.ComponentDefinition.MassProperties
		oCenterOfMass = massProps.CenterOfMass
		workPointName = "Shipping Center Of Gravity"
	Else
		'Body specific case
		Dim PickThis As SurfaceBody = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartBodyFilter, "Select a Solid")
		If IsNothing(PickThis) Then Exit Sub ' If nothing gets selected then we're done
		'Create a temporay derived part document
		Dim TempDoc As PartDocument = ThisApplication.Documents.Add(DocumentTypeEnum.kPartDocumentObject, , False)
		Dim oDerivedPartDef As DerivedPartUniformScaleDef = TempDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.CreateUniformScaleDef(partDoc.FullFileName)
    	'Derived Part Options:
		oDerivedPartDef.ScaleFactor = 1
    	oDerivedPartDef.ExcludeAll()
    	oDerivedPartDef.UseColorOverridesFromSource = False
		oDerivedPartDef.Solids.Item(PickThis.Name).IncludeEntity = True
    	Call TempDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Add(oDerivedPartDef)
		'Set values
		massProps = TempDoc.ComponentDefinition.MassProperties
		oCenterOfMass = massProps.CenterOfMass
		workPointName = PickThis.Name & " Center Of Gravity"
		'Close Temp doc without saving
		TempDoc.Close(True)
	End If
Else
	'Assembly case not expanded for single body selection
  	Dim assemDoc As AssemblyDocument = doc
  	massProps = assemDoc.ComponentDefinition.MassProperties
  	oCenterOfMass = massProps.CenterOfMass
  	workPoints = assemDoc.ComponentDefinition.WorkPoints
  	workPointName = "Shipping Center Of Gravity"
End If

' Check to see if a work point for center of mass already exists.
' This uses the name of the work feature to identify it.
Dim oWorkPoint As WorkPoint
Try
    oWorkPoint = workPoints.Item(workPointName)
Catch
    oWorkPoint = Nothing
End Try

If (oWorkPoint IsNot Nothing) Then
    If (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject) Then
            Dim oFixedDef As FixedWorkPointDef = oWorkPoint.Definition
            oFixedDef.Point = oCenterOfMass
    Else
            Dim oFixedDef As AssemblyWorkPointDef = oWorkPoint.Definition
            oFixedDef.Point = oCenterOfMass
    End If
    doc.Update
Else
    ' Create a new workpoint at the location of the center of mass.
    oWorkPoint = workPoints.AddFixed(oCenterOfMass)

    ' Rename the work point.
    oWorkPoint.Name = workPointName
End If

I did not expand the assembly functionality, only the Part option allows solid selection.

Let me know if you have any questions, or if it is not working as desired.

[WCrihfield]

Here is an idea that uses the OrientedMinimumRangeBox of each body, then finds the center point of that OrientedBox, then creates a WorkPoint at that point.  It basically finds the center of that 'rectangular prism' the old school way, without having to do any math. 😉

If ThisApplication.ActiveDocumentType <> DocumentTypeEnum.kPartDocumentObject Then
	MsgBox("This rule '" & iLogicVb.RuleName & "' only works for Part Documents.",vbOKOnly, "WRONG DOCUMENT TYPE")
	Return
End If
Dim oPDoc As PartDocument = ThisApplication.ActiveDocument
Dim oPDef As PartComponentDefinition = oPDoc.ComponentDefinition
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
Dim oBodies As SurfaceBodies = oPDef.SurfaceBodies
Dim oBody As SurfaceBody ' = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartBodyFilter,"Select a body.")
Dim oCorner As Point, oD1, oD2, oD3 As Vector
Dim oC1, oC2, oC3, oCP As Point
Dim oL1, oL2, oL3 As LineSegment 'triangle lines
Dim oBL1, oBL2 As LineSegment 'bisecting lines
Dim oPts As ObjectsEnumerator 'intersecting points (should only contain 1)
Dim oWP As WorkPoint
For Each oBody In oBodies
	oBody.OrientedMinimumRangeBox.GetOrientedBoxData(oCorner, oD1, oD2, oD3)
		'Create points at the ends of the 3 vectors
	oC1 = oCorner.Copy
	oC1.TranslateBy(oD1)
	oC2 = oCorner.Copy
	oC2.TranslateBy(oD2)
	oC3 = oCorner.Copy
	oC3.TranslateBy(oD3)
	'Draw a triangle with LineSegments using the 3 new points
	oL1 = oTG.CreateLineSegment(oC1, oC2)
	oL2 = oTG.CreateLineSegment(oC2, oC3)
	oL3 = oTG.CreateLineSegment(oC3, oC1)
	'The 'Centroid' of this triangle is the center of the rectangular prism
	'The 'Centroid' is the intersection point of all 3 bisecting lines of the triangle
	'Draw at least 2 of the 3 bisecting lines to get their intersection
	oBL1 = oTG.CreateLineSegment(oC1, oL2.MidPoint)
	oBL2 = oTG.CreateLineSegment(oC2, oL3.MidPoint)
	oPts = oBL1.IntersectWithCurve(oBL2)
	oCP = oPts.Item(1)
	oWP = oPDef.WorkPoints.AddByPoint(oCP)
	oWP.Name = "CenterPoint of " & oBody.Name
Next

[_dscholtes_]

@WCrihfield 

WCrihfield  wrote: So, there apparently is not a property for CenterOfMass or CenterOfGravity for SurfaceBody objects.

Clearly, @moraesorlando mentions solids in his post.

 @J-Camper

JCamper  wrote: Basically you create a temporary derived part with only 1 selected body

Clearly, @moraesorlando mentions 'more than one' solid in his post.

@moraesorlando 
I stripped you code to only the bare necessities and tested it with a multibody part of my own. It works successfully. 

Dim partDoc As PartDocument = ThisDoc.Document
    
If (partDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject) Then
    Dim massProps As MassProperties = partDoc.ComponentDefinition.MassProperties
    Dim oCenterOfMass As Point= massProps.CenterOfMass
    Dim oWorkPoint As WorkPoint = partDoc.ComponentDefinition.WorkPoints.AddFixed(oCenterOfMass)
End If

And on an assembly, this also works for me:

Dim assDoc As AssemblyDocument = ThisDoc.Document
    
If (assDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject) Then
    Dim massProps As MassProperties= assDoc.ComponentDefinition.MassProperties
    Dim oCenterOfMass As Point= massProps.CenterOfMass
    Dim oWorkPoint As WorkPoint = assDoc.ComponentDefinition.WorkPoints.AddFixed(oCenterOfMass)
End If

So the error(s) is(are) somewhere in all the additional code you wrote.

[WCrihfield]

@_dscholtes_ 

   A SurfaceBody object can be either a solid or a collection of connected surfaces (similar to a FaceShell), but unfortunately both use the same named API Object.  You specify which one you want either by how you get them.  The way I'm accessing them, is the most common way to get all Solid bodies.  There are other ways to access only the (surface only) SurfaceBodies, or you can just check the 'IsSolid' property of the SurfaceBody object.

   Apparently you didn't read below the code in @moraesorlando  first post, where he says "My goal at this moment is to get help to adapt this code to became possible to add center of gravities points in several solids, by selecting one solid each time."  That is precisely what our codes were attempting to do.  Create a 'center of gravity' (or the next closest thing), for either a selected body (among multiple) or , in my case, I chose to show how to find the center of each solid, and showed the 'Pick' method, but commented it out for now.

The first code you posted only creates one WorkPoint, and the way it is written, that WorkPoint might not be within any of the individual bodies.  It could just be created between them.

I could be wrong, but I thought the intention was to either:

• create a 'Center of Gravity' type WorkPoint at the center of only the one selected solid body
• Or at the center of each individual selected body (multiple selections).

We've already established that the we can get the CenterOfMass from the ComponentDefinition (which encompasses all geometry within the model), so it will not be ideal for a multi-body solid.  We've also already established that each SurfaceBody (or body, or solid body, all the same) does not have its own mass properties nor its own CenterOfMass property, so its center will have to be found through other means.  By either dividing the individual bodies out to their own parts, or by finding their individual geometric centers.

[_dscholtes_]

but unfortunately both use the same named API Object.

And that's where I went wrong. My apologies, please discard my remark towards you.

Apparently you didn't read below the code in @moraesorlando  first post, where he says "My goal at this moment is to get help to adapt this code to became possible to add center of gravities points in several solids, by selecting one solid each time."

I did read the 'selecting one solid at each time'. But @moraesorlando 's issue with the code not working with multibody parts can be solved without adding code to select each solid separately. So I discarded his suggested approach for a solution and solved the issue at the root.

The first code you posted only creates one WorkPoint, and the way it is written, that WorkPoint might not be within any of the individual bodies.  It could just be created between them.

That's the nature of a center of gravity. It doesn't have to be inside any of the bodies of a multibody part. It all depends on the overall shape (think donuts).

I don't know why @moraesorlando suggested his approach for a solution, maybe to calculate the overall center of gravity using the individual centers of the selected bodies. Or maybe he does want work points for each individual solid. Now he can decide whether to stick with his approach and use your code or rewrite / update his code in his topic start using of my code.

[J-Camper]

@_dscholtes_,

@moraesorlandodid not post his code as a solution.  He found the code somewhere else, which works for Center of Gravity of the overall part just fine, no errors. 

The questioned posed was how to get Center of gravity for individual solid bodies within a multi-solid body part by selecting 1 solid at a time.

@WCrihfield  and I were helping to figure out a way to get center of gravity point data for each solid within a multi-solid part file, as there is not a "MassProperties" method for individual solid bodies themselves.

[_dscholtes_]

@J-Camper wrote:

which works for Center of Gravity of the overall part just fine, no errors. 

I disagree, since @moraesorlando stated the following:

But in my real situation I have more than one solid in the ipt file (solid1, solid2, solid3 …) and for this case, this code doesn’t work.

So I simply proved that there is code that will work in his real situation (a multibody part).

I agree that @moraesorlando's asked how to get Center of gravity for individual solid bodies within a multi-solid body by selecting 1 solid at a time, so my remark towards you was incorrect.

[J-Camper]

@_dscholtes_,

All I meant by works "no errors" is that the rule works as designed.  The starting block of code that @moraesorlando  posted was designed to give overall center of gravity for parts and assemblies for shipping purposes.

I believe when @moraesorlando  Says, "But in my real situation I have more than one solid in the .ipt file (solid1, solid2, solid3 …) and for this case, this code doesn’t work."    It is because he wants to modify the code to give center of gravity for individual solids instead of, or in addition to, the overall part center of gravity. 

The verbiage of that statement could lead someone to believe the code fails for multi-body parts if read out of context.  But simply running a test yourself will prove that the code does not fail to produce the originally designed result.

[moraesorlando]

Hello felows @WCrihfield, @J-Camper  and @_dscholtes_ !

First of all thanks for the help for all of you.

I always be glad when my doubts generate a positive discussion and led us to learn more about subjects related to Inventor.

I could see that there was a possible doubt about my real goal.

Indeed the code I have posted works correctly when the user has only one solid in the ipt file, but in my case I have more than one solid and I desire to create one center of gravity for each solid in the ipt file.

I have created a file with a situation very similar to my real situation and I think that when you open the file all the doubts about my situation will be clear.

I have tested the codes suggest by @WCrihfield  and @J-Camper 

When I pasted the code from @WCrihfield within the rule editor, I could not save the code and

I received the error message attached.

I have transformed the line indicated with error to comment in order to get save the rule.

I also have tried the code suggest from the @Jcamper and the result is very close with my goal.
I think with a little adjust the goal will be reached.

@J-Camper 

When I run the code you suggested I received a message, I clicked NO and selected the first body and the point was created correctly.

I have repeated the process and have created the points in the other two solids.

Very good!

But when I changed one of the solids (adding material for example) Its important that the point created, be automatically repositioned according to new position of the center of gravity (due the material added).

I have run the code selecting this solid that was changed, and I could see that the point is relocated, because of this I think that is just a case of a small adjust.

So, do you think is possible to relocate the center of gravity point existent in the solid automatically when it is changed?

One more time thanks for all of you for the help.

Best regards,

[J-Camper · Accepted solution]

Do you always want a point at every solid in the Part Document?  If so, we can change the manual selection to a loop for all solids and then set it to an event trigger (Sample part  event trigger is set for "before saving"). 

I did this in the following code (Sample part attached):

Sub Main
	' Check to make sure a part or assembly document is active.
	Dim doc As Document = ThisDoc.Document
	If doc.DocumentType <> DocumentTypeEnum.kPartDocumentObject AndAlso doc.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then
	    MessageBox.Show(" This rule can only be run in a part or assembly.", "WorkPoint At Mass Center")
	    Exit Sub
	End If
	'Setup
	Dim massProps As MassProperties
	Dim workPoints As WorkPoints
	Dim oCenterOfMass As Point
	Dim workPointName As String
	'Selection Type
	If (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject)
		Dim partDoc As PartDocument = doc
		workPoints = partDoc.ComponentDefinition.WorkPoints
		'If Part is single solid body skip to overal
		If partDoc.ComponentDefinition.SurfaceBodies.Count = 1 
			massProps = partDoc.ComponentDefinition.MassProperties
			oCenterOfMass = massProps.CenterOfMass
			workPointName = "Shipping Center Of Gravity"
			
			Call WorkPointEval(doc, workPoints, workPointName, oCenterOfMass)
		Else
			'Body specific case
			For Each b As SurfaceBody In partDoc.ComponentDefinition.SurfaceBodies
				If b.IsSolid = True
					'Create a temporay derived part document
					Dim TempDoc As PartDocument = ThisApplication.Documents.Add(DocumentTypeEnum.kPartDocumentObject, , False)
					Dim oDerivedPartDef As DerivedPartUniformScaleDef = TempDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.CreateUniformScaleDef(partDoc.FullFileName)
			    	'Derived Part Options:
					oDerivedPartDef.ScaleFactor = 1
			    	oDerivedPartDef.ExcludeAll()
			    	oDerivedPartDef.UseColorOverridesFromSource = False
					oDerivedPartDef.Solids.Item(b.Name).IncludeEntity = True
			    	Call TempDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Add(oDerivedPartDef)
					'Set values
					massProps = TempDoc.ComponentDefinition.MassProperties
					oCenterOfMass = massProps.CenterOfMass
					workPointName = b.Name & " Center Of Gravity"
					'Close Temp doc without saving
					TempDoc.Close(True)

					Call WorkPointEval(doc, workPoints, workPointName, oCenterOfMass)
				End If
			Next
		End If
	Else
		'Assembly case not expanded for single body selection
	  	Dim assemDoc As AssemblyDocument = doc
	  	massProps = assemDoc.ComponentDefinition.MassProperties
	  	oCenterOfMass = massProps.CenterOfMass
	  	workPoints = assemDoc.ComponentDefinition.WorkPoints
	  	workPointName = "Shipping Center Of Gravity"
		
		Call WorkPointEval(doc, workPoints, workPointName, oCenterOfMass)
	End If
	doc.Update
End Sub 

Sub WorkPointEval(d As Document, wpCol As WorkPoints, wpName As String, p As Point)
	' Check to see if a work point for center of mass already exists.
	' This uses the name of the work feature to identify it.
	Dim oWorkPoint As WorkPoint
	Try
	    oWorkPoint = wpCol.Item(wpName)
	Catch
	    oWorkPoint = Nothing
	End Try
	If (oWorkPoint IsNot Nothing) Then
	    If (d.DocumentType = DocumentTypeEnum.kPartDocumentObject) Then
	            Dim oFixedDef As FixedWorkPointDef = oWorkPoint.Definition
	            oFixedDef.Point = p
	    Else
	            Dim oFixedDef As AssemblyWorkPointDef = oWorkPoint.Definition
	            oFixedDef.Point = p
	    End If
	Else
	    ' Create a new workpoint at the location of the center of mass.
	    oWorkPoint = wpCol.AddFixed(p)

	    ' Rename the work point.
	    oWorkPoint.Name = wpName
	End If
End Sub

[WCrihfield · Accepted solution]

Looks like I need to post a revised version of my earlier code.

For some reason several other peoples systems don't like how I include the rule's name within the MsgBox of my document type check code.  It has always worked fine for me, and lets me know exactly which rule (when there are many) is the one showing the message.  Soc I simply deleted that little portion of that message.

Also, after testing my code in several more scenarios, I found it wasn't truly working as intended (wasn't true center).

The corrected code is actually even simpler than the original.

Since oC1 and oC3 are on opposite corners of the same face of the rectangular prism, I just created a transient line segment between the two points, then got its Midpoint.  Then all I had to do was translate that Midpoint in the same direction as the oD2 vector, but half the distance (half the thickness of the prism), to get its true center point.

I realize this center point still isn't always the same as the Center of Gravity (or Center of Mass), and that this code only works for Parts and not Assemblies, but I just wanted to correct the code I posted earlier, in case it may help others later, trying to do the same thing.

Here's the updated code, that passed multiple tests.

(Finds the geometric center point of the body, using its OrientedMinimumRangeBox.)

If ThisApplication.ActiveDocumentType <> DocumentTypeEnum.kPartDocumentObject Then
	MsgBox("This rule only works for Part Documents.",vbOKOnly, "WRONG DOCUMENT TYPE")
	Exit Sub
End If
Dim oPDoc As PartDocument = ThisApplication.ActiveDocument
Dim oPDef As PartComponentDefinition = oPDoc.ComponentDefinition
Dim oWP As WorkPoint
If Not oPDef.HasMultipleSolidBodies Then
	oWP = oPDef.WorkPoints.AddFixed(oPDef.MassProperties.CenterOfMass)
	oWP.Name = "Center Of Mass"
	Exit Sub
End If
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
Dim oBodies As SurfaceBodies = oPDef.SurfaceBodies
Dim oBody As SurfaceBody
Dim oCorner As Point, oD1, oD2, oD3 As Vector
Dim oC1, oC3, oCP As Point
Dim oL1 As LineSegment
Dim oHalfVector As Vector
For Each oBody In oBodies
	If Not oBody.IsSolid Then Continue For
	oBody.OrientedMinimumRangeBox.GetOrientedBoxData(oCorner, oD1, oD2, oD3)
	oC1 = oCorner.Copy
	oC1.TranslateBy(oD1)
	oC3 = oCorner.Copy
	oC3.TranslateBy(oD3)
	oL1 = oTG.CreateLineSegment(oC1, oC3)
	oCP = oL1.MidPoint.Copy
	oHalfVector = oD2.Copy
	oHalfVector.ScaleBy(.5)
	oCP.TranslateBy(oHalfVector)
	oWP = oPDef.WorkPoints.AddFixed(oCP)
	oWP.Name = "CenterPoint of " & oBody.Name
Next

[moraesorlando]

Hello @WCrihfield !

Yes, is very good leave the code working for the other colleagues that may needs in the future, or even for us in further consults.

Thank you very much for your help.

I hope see you in the next Inventor challenges.

Best regards,

[moraesorlando]

Hello @J-Camper !

Yes, I always going to need a point in every solids bodies in the file.

Well thought, this change of replacing a manual selection for a loop suits very well in my needs.

Very good. Congratulations!

I open and checked the sample file and works perfectly, I will transport the code for my real situation!

One more time thank you very much for your help.

See you in next post.

Best regards,

Best regards,