利用catia的Mark3D的接口，添加3D标注，話不多說，直接代碼：

Sub AddLabel(ByVal LabelTxt As String)

Dim oSelection 'As Selection

Set oSelection = CATIA.ActiveDocument.Selection

Dim oProduct As AnyObject

On Error Resume Next

Set oProduct = oSelection.FindObject("CATIAProduct")

If (Err.Number <> 0) Then

Dim SelectStatus As String, SelectType(0)

SelectType(0) = "Product"

SelectStatus = oSelection.SelectElement2(SelectType, "Select a Product", False)

If SelectStatus = "Cancel" Then Exit Sub

Set oProduct = oSelection.Item(1).value

End If

On Error GoTo 0

Dim dPosition(11)

oProduct.Position.GetComponents dPosition

If Trim(LabelTxt) = "" Then LabelTxt = oProduct.name & " / " & oProduct.PartNumber

' Retrieve the marker3Ds collection

Dim cMarker3Ds 'As AnyObject

Set cMarker3Ds = oProduct.GetTechnologicalObject("Marker3Ds")

' Create the marker3D

Dim dPosition1(2)

dPosition1(0) = dPosition(0)

dPosition1(1) = dPosition(1)

dPosition1(2) = dPosition(2)

Dim dPosition2(2)

dPosition2(0) = dPosition(0) 50#

dPosition2(1) = dPosition(1) 50#

dPosition2(2) = dPosition(2) 50#

Dim oMarker3D As Marker3D

Set oMarker3D = cMarker3Ds.Add3DText(dPosition2, LabelTxt, dPosition1, oProduct)

oMarker3D.TextSize = 15

oMarker3D.Fill = 0

oMarker3D.Frame = 1

' oMarker3D.TextFont = "Arial Unicode MS (TrueType)"

oMarker3D.Update

End Sub

運行後效果如下：

更多精彩资讯请关注tft每日頭條，我们将持续为您更新最新资讯!