如何从绝对坐标系提取CATIA中孔的重心（COG）坐标

要获取绝对坐标系（零件原点坐标系）下的孔重心，你只需要在创建Measurable对象时指定参考坐标系为零件的绝对轴系即可。以下是修改后的代码：

Sub main()
    Dim oPartDoc As Document
    Set oPartDoc = CATIA.ActiveDocument

    Dim selection2 As Selection
    Set selection2 = oPartDoc.Selection

    selection2.Search ("Type=Hole,all")

    ' 获取零件的绝对坐标系（原点轴系）
    Dim oAbsoluteAxis As AxisSystem
    Set oAbsoluteAxis = oPartDoc.Part.OriginElements.AxisSystem

    Dim TheSPAWorkbench As SPAWorkbench
    Set TheSPAWorkbench = oPartDoc.GetWorkbench("SPAWorkbench")

    For i = 1 To selection2.Count
        Dim ocircle As Variant
        Set ocircle = selection2.Item(i).Value

        ' 创建Measurable时传入绝对坐标系作为参考
        Dim TheMeasurable As Measurable
        Set TheMeasurable = TheSPAWorkbench.GetMeasurable(ocircle, oAbsoluteAxis)
        
        Dim Coordinates(2) As Double
        TheMeasurable.GetCOG Coordinates
        
        MsgBox "绝对坐标系下重心 : X = " & CStr(Coordinates(0)) & ", Y = " & CStr(Coordinates(1)) & ", Z = " & CStr(Coordinates(2))
    Next

    selection2.Clear
End Sub

关键修改说明： #

1. 获取绝对坐标系：通过oPartDoc.Part.OriginElements.AxisSystem获取零件的默认绝对轴系（以原点为基准的坐标系）。
2. 指定Measurable的参考坐标系：调用GetMeasurable时传入第二个参数oAbsoluteAxis，这样GetCOG方法就会直接返回该坐标系下的坐标值，无需额外转换。

如果上述方法因版本或元素类型问题不生效，也可以用坐标转换的方式兜底：先获取局部坐标，再通过TranslateCoordinates方法转换到绝对坐标系：

' 在获取局部Coordinates之后添加以下代码
Dim absoluteCoords(2) As Double
' 将局部坐标转换为绝对坐标
oPartDoc.Part.TranslateCoordinates Coordinates, ocircle.Parent, oAbsoluteAxis, catAbsoluteAxis, absoluteCoords
' 此时absoluteCoords就是绝对坐标系下的坐标
MsgBox "绝对坐标系下重心 : X = " & CStr(absoluteCoords(0)) & ", Y = " & CStr(absoluteCoords(1)) & ", Z = " & CStr(absoluteCoords(2))

注意：ocircle.Parent需要确保是孔所在的局部坐标系载体（如草图或特征坐标系），如果不确定，可以通过ocircle.Reference获取其关联的坐标系。

内容的提问来源于stack exchange，提问作者Harish