如何在CATIA的VB/VBA宏中创建Far点而非Near点

我在编写CATIA VB.NET宏时，无法创建Far点。尝试录制宏时，无论操作如何，都只生成创建Near点的代码；查阅官方文档也仅提及AddNewNear方法，找不到对应的Far点创建接口。甚至手动将Near点改为Far点后录制宏，得到的代码依然是创建另一个Near点。

原宏代码片段：

' 创建点
Dim hybridShapePointCoord1 As HybridShapePointCoord = hybridShapeFactory1.AddNewPointCoord(0#, 0#, 10.0#)
hybridBody1.AppendHybridShape(hybridShapePointCoord1)
part.InWorkObject = hybridShapePointCoord1
part.Update()

' 创建直线
Dim referencePoint1 As Reference = part.CreateReferenceFromObject(hybridShapePointCoord1)
Dim hybridShapeDirection1 As HybridShapeDirection = hybridShapeFactory1.AddNewDirectionByCoord(0#, 0#, 1.0#)
Dim hybridShapeLinePtDir1 As HybridShapeLinePtDir = hybridShapeFactory1.AddNewLinePtDir(referencePoint1, hybridShapeDirection1, -100.0#, 100.0#, False)
hybridBody1.AppendHybridShape(hybridShapeLinePtDir1)
part.InWorkObject = hybridShapeLinePtDir1
part.Update()

' 创建交线
Dim referenceLine As Reference = part.CreateReferenceFromObject(hybridShapeLinePtDir1)
Dim referenceBody As Reference = part.CreateReferenceFromObject(body)
Dim hybridShapeIntersection1 As HybridShapeIntersection = hybridShapeFactory1.AddNewIntersection(referenceLine, referenceBody)
hybridShapeIntersection1.PointType = 0 ' 根据需要调整
hybridBody1.AppendHybridShape(hybridShapeIntersection1)
part.InWorkObject = hybridShapeIntersection1
part.Update()

' 创建Near点
Dim referenceIntersection As Reference
referenceIntersection = part.CreateReferenceFromObject(hybridShapeIntersection1)

Dim hybridShapeNear1 As HybridShapeNear
hybridShapeNear1 = hybridShapeFactory1.AddNewNear(referenceIntersection, referencePoint1)

hybridBody1.AppendHybridShape(hybridShapeNear1)

Dim hybridShapeNear2 As HybridShapeNear
hybridShapeNear2 = hybridShapeFactory1.AddNewNear(referenceIntersection, referencePoint1)

hybridBody1.AppendHybridShape(hybridShapeNear2)

手动修改Near为Far后录制的宏代码：

Sub CATMain()

Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument

Dim part1 As Part
Set part1 = partDocument1.Part

Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies

Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("Some Geoset")

Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = hybridBody1.HybridShapes

Dim hybridShapeIntersection1 As HybridShapeIntersection
Set hybridShapeIntersection1 = hybridShapes1.Item("Intersect.1")

Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(hybridShapeIntersection1)

Dim hybridShapePointCoord1 As HybridShapePointCoord
Set hybridShapePointCoord1 = hybridShapes1.Item("Point.13")

Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(hybridShapePointCoord1)

Dim hybridShapeNear1 As HybridShapeNear
Set hybridShapeNear1 = hybridShapeFactory1.AddNewNear(reference1, reference2)

hybridBody1.AppendHybridShape hybridShapeNear1

part1.InWorkObject = hybridShapeNear1

part1.Update

Set partDocument1 = CATIA.ActiveDocument

partDocument1.Save

End Sub

解决方案 #

CATIA的API中，Near点和Far点共用HybridShapeNear对象，只需修改其Orientation属性即可切换类型：

• 属性值0：创建Near点（默认）
• 属性值1：创建Far点

修改后的代码示例（替换原代码中创建Near点的部分）：

' 创建Far点
Dim referenceIntersection As Reference
referenceIntersection = part.CreateReferenceFromObject(hybridShapeIntersection1)

' 第一个Far点
Dim hybridShapeFar1 As HybridShapeNear
hybridShapeFar1 = hybridShapeFactory1.AddNewNear(referenceIntersection, referencePoint1)
hybridShapeFar1.Orientation = 1 ' 设置为Far点
hybridBody1.AppendHybridShape(hybridShapeFar1)

' 第二个Far点
Dim hybridShapeFar2 As HybridShapeNear
hybridShapeFar2 = hybridShapeFactory1.AddNewNear(referenceIntersection, referencePoint1)
hybridShapeFar2.Orientation = 1 ' 设置为Far点
hybridBody1.AppendHybridShape(hybridShapeFar2)

' 更新模型
part.InWorkObject = hybridShapeFar2
part.Update()

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