CATIA VBA 测量距离

原文链接

因为CATIA V5 的测量工具接口未暴露给VBA; 因此宏记录器不会记录测量代码. 但是我们可以用别的方式，使用VBA实现测距功能.

测量工具接口未暴露给VBA

方法1 参数、关系法

（经测试，此方式不能测量多个Part间元素的距离）
第一步，创建参数和关系。在我们写代码以前，最好先手工操作一下，这样更加便于我们准确理解整个流程。
以下是手工操作步骤：

1.创建类型为Length的参数，保持默认值0mm，当然也可以自定义参数名称。

catia parameter length macros

2.点击添加公式

3. 找到左侧的Measure，然后选择 distance (Body, Body); Length

catia formula editor

4. 选择您想测量的2个图形元素（可以是Objects也可以是特征）。大功告成！
以下为相应代码：

'this macro creates a parameter and relation to measure the distance between two points

Language="VBSCRIPT"

Sub  CATMain()

'active document is a single part file'

Dim  partDocument1 As  Document

Set  partDocument1  =  CATIA.ActiveDocument

Dim  part1 As  Part

Set  part1  =  partDocument1.Part

Dim  parameters1 As  Parameters

Set  parameters1  =  part1.Parameters

'create a new length type parameter, set its value to 0 for now'

Dim  length1 As  Dimension

Set  length1  =  parameters1.CreateDimension("",  "LENGTH",  0.000000)

'if you want to rename the parameter'

length1.Rename  "MeasureDistance"

'create a new formula to link to the parameter'

Dim  relations1 As  Relations

Set  relations1  =  part1.Relations

'make sure points are labeled MyEndPt1 and MyEndPt2 respectively'

Dim  formula1 As  Formula

Set  formula1  =  relations1.CreateFormula("Formula.2",  "",  length1,  "distance(`Geometrical Set.1\MyEndPt1` ,`Geometrical Set.1\MyEndPt2` ) ")

'rename the formula'

formula1.Rename  "Distance"

'display the distance the endpoints are apart in a messagebox'

Msgbox  "The endpoints are "  &  length1.ValueAsString  &  " apart."

End  Sub

测试的CATPart 结构树如下图。注意下面的参数和关系是程序刚刚创建的（绿色的测量是手工创建的，目的是验证程序的准确性）。

how to measure distance between two points catia

上面这段代码除了可以测量两个点的距离，也可以用来测量点面间距，只需要把代码稍作修改：

Set  formula1  =  relations1.CreateFormula("Formula.2",  "",  length1,  "distance(`Geometrical Set.1\MyEndPt1` ,`Geometrical Set.1\MyEndPt2` ) ")

改成：

Set  formula1  =  relations1.CreateFormula("Formula.2",  "",  length1,  Distance(‘Geometrical Set.1\MyEndPt1’  ,  ‘Geometrical Set.1\Plane.1’)")

**方法2 SPAWORKBENCH **

另外一个方法是使用SPAWorkbench 属性及方法，但前提是CATIA需要有DMU授权，否则，这个接口不能使用。以下为参考代码

Sub  CATMain()

'active document must be a CATPart

Dim  documents1 As  Documents

Set  documents1  =  CATIA.Documents

Dim  pDocument1 As  PartDocument

Set  pDocument1  =  CATIA.ActiveDocument

Dim  part1 As  Part

Set  part1  =  pDocument1.Part

Dim  hybridBodies1 As  HybridBodies

Set  hybridBodies1  =  part1.HybridBodies

Dim  reference1 As  Reference

Dim  hybridBody1 As  HybridBody

Set  hybridBody1  =  hybridBodies1.Item(1)

Set  hybridShapes1  =  hybridBody1.HybridShapes

Set  reference1  =  hybridShapes1.Item("MyEndPt1")

'if code not working properly use msgbox to check reference name

'MsgBox ("ref1=" & reference1.Name)

Dim  reference2 As  Reference

Set  reference2  =  hybridShapes1.Item("MyEndPt2")

'built in check if needed

'MsgBox ("ref2=" & reference2.Name)

'get the SPAworkbench

Dim  TheSPAWorkbench As  Workbench

Set  TheSPAWorkbench  =  CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")

Dim  TheMeasurable As  Measurable

Set  TheMeasurable  =  TheSPAWorkbench.GetMeasurable(reference1)

Dim  MinimumDistance As  Double

MinimumDistance  =  TheMeasurable.GetMinimumDistance(reference2)

'display the result

MsgBox MinimumDistance

End  Sub

spaworkbench measure

P.S. GetWorkbench 命令输入一个string，返回一个 Workbench 对象. 在CATIA里，每个Workbench都有一个对应的ID.

---

原文链接

如果建立Group，是否也可测量Group的距离？
如果有朋友了解Group，欢迎留言讨论:
以下代码未做测试，仅为猜想：

    Dim MyDoc  As Document
    Set MyDoc = CATIA.ActiveDocument
   
    Dim MainProduct As Product
    Set MainProduct = MyDoc.Product
   
    Dim product1 As Product
    Dim product2 As Product
   
    Set product1 = MainProduct.Products.Item("Part1.1")
    Set product2 = MainProduct.Products.Item("Part2.1")
   
    Dim FirstGroup As Group
    Dim cGroups As Groups
    Set cGroups = CATIA.ActiveDocument.Product.GetTechnologicalObject("Groups")
    Dim oGroup1 As Group
    Dim oGroup2 As Group
    Set oGroup1 = cGroups.Add
    Set oGroup2 = cGroups.Add
   
    Dim cDistances As Distances
    Set cDistances = CATIA.ActiveDocument.Product.GetTechnologicalObject("Distances")
   
    Dim NewDistance As Distance
    Set NewDistance = cDistances.Add
    oGroup1.AddExplicit product1
    oGroup2.AddExplicit product2
   
    NewDistance.FirstGroup = oGroup1
    NewDistance.SecondGroup = oGroup2
    NewDistance.ComputationType = catDistanceComputationTypeBetweenTwo
    NewDistance.MeasureType = catDistanceMeasureTypeMinimum
    NewDistance.Compute
    MsgBox NewDistance.Value

---

测量一个Product下不同Part元素的距离

原文链接

以下代码主要依靠CreateReferenceFromName，注意他的 参数的写法，详见如下：

' create reference to a point on the assembly level'
Dim refCLP As Reference
'OLD CODE: Set refCLP = ClampPart.CreateReferenceFromObject(ClampLocationPoint)'
Set refCLP = main_prod.CreateReferenceFromName(main_prod.PartNumber & "/" & prod1.Name & "/" & prods.Item(1).Name & "/!Point1")

Dim TheSPAWorkbench As Workbench
Set TheSPAWorkbench = catia.ActiveDocument.GetWorkbench("SPAWorkbench")

Dim TheMeasurable 'As Measurable'
Dim Coordinates(8)
Dim min_dist As Double
Dim MainAssyPart As Part
Set MainAssyPart = main_prods.Item(2).ReferenceProduct.Parent.Part

Dim AssyPartOrigin
Set AssyPartOrigin = MainAssyPart.FindObjectByName("OPoint")

' create reference to origin point (on the assembly level)'
Dim refAPO As Reference
Set refAPO = main_prod.CreateReferenceFromName(main_prod.PartNumber & "/" & main_prods.Item(2).Name & "/!OPoint")

'OLD CODE: Dim refAxisOrigin As Reference'
'OLD CODE: Set refAxisOrigin = MainAssyPart.CreateReferenceFromObject(AssyPartOrigin)'
'OLD CODE: Set TheMeasurable = TheSPAWorkbench.GetMeasurable(ClampLocationPoint)'

'OLD CODE: TheMeasurable.GetMinimumDistancePoints refAxisOrigin, Coordinates'
Set TheMeasurable = TheSPAWorkbench.GetMeasurable(refAPO)

' measure distance between two points (from AssyPartOrigin to ClampLocationPoint)'
Dim dDistance ' as Double'
dDistance = TheMeasurable.GetMinimumDistance(refCLP)