需要从绝对轴系统测量坐标值-解网

问：

请帮我解决这个问题。

我想测量孔 COG。我编写了代码，它工作正常，但问题是 COG 值是从局部轴上获取的。我希望它始终相对于绝对轴系统提取 COG。默认情况下，它选取局部轴

请在此处找到以下代码

Sub main()

Dim oPartDoc As document
Set oPartDoc = CATIA.ActiveDocument

Dim selection2 As Selection
Set selection2 = oPartDoc.Selection


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

For i = 1 To selection2.Count

Dim ocircle As Variant

Set ocircle = selection2.Item(i).Value


        Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
        Set TheMeasurable = TheSPAWorkbench.GetMeasurable(ocircle)
    
        Dim Coordinates(2)
        TheMeasurable.GetCOG Coordinates
        x1 = Coordinates(0)
        y1 = Coordinates(1)
        z1 = Coordinates(2)

        
        MsgBox "Center of gravity : X = " & _
            CStr(Coordinates(0)) & ", Y = " + CStr(Coordinates(1)) & ", Z = " + CStr(Coordinates(2))

Next

selection2.Clear
End Sub

VBA CATIA卡蒂亚

Dim oRoot As Product
Set oRoot = CATIA.ActiveDocument.Product

Dim oPartProd As Product
Set oPartProd = oRoot.Products.Item("Part2.1") 'this is a specific instance product

Dim oPart As Part
Set oPart = oPartProd.ReferenceProduct.Parent.Part 'get the part from the instance product

Dim oBodyRef As Reference
Set oBodyRef = oPart.CreateReferenceFromObject(oPart.Bodies.Item(1)) 'part reference to the PartBody

Dim oSPA As SPAWorkbench
Set oSPA = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench") 'get the SPA workbench from the root assembly

Dim oRefMeasurable As Measurable
Set oRefMeasurable = oSPA.GetMeasurableInContext(oBodyRef, oPartProd) 'measurable in assembly context *NEW in R29*

Dim cog(2)
Dim vMeas As Variant
Set vMeas = oRefMeasurable
Call vMeas.GetCOG(cog)

Debug.Print "PRODUCT COG = " & cog(0) & " " & cog(1) & " " & cog(2)

需要从绝对轴系统测量坐标值

Need to measure coordinates value from absolute axis system

评论

评论