我正在尝试在CATIA中创建一个定位草图。但我坚持创造飞机。在我的代码下面标有错误行

Question

我已经标记了发生错误的行。

语言= “VBSCRIPT”

Sub CATMain()

Dim ProdDoc As Document
Set ProdDoc = CATIA.ActiveDocument

Dim product1 As Product
Set product1 = ProdDoc.Product

Dim products1 As Products
Set products1 = product1.Products

Dim product2 As Product
Set product2 = products1.AddNewComponent("Part", "NewPart1")

Dim documents1 As Documents
Set documents1 = CATIA.Documents

Dim partDocument1 As Document
Set partDocument1 = documents1.Item("NewPart1.CATPart")

Dim NewPart1 As Part
Set NewPart1 = partDocument1.Part

Dim hybridShapeFactory1 As Factory
Set hybridShapeFactory1 = NewPart1.HybridShapeFactory

Dim parameters1 As Parameters
Set parameters1 = NewPart1.Parameters

Dim oSel As Selection
Set oSel = prodDoc.Selection

Dim point_ref 
Dim line_ref 
Dim Point As Reference 
Dim Line As Reference 

'选择点和边的变量

 Dim iot1(0)
  iot1(0) = "Vertex"
  Dim iot2(0)
   iot2(0)="TriDimFeatEdge"

  Status = oSel.SelectElement2(iot1, "Select a line", False)

  msgbox oSel.Item(1).Type

  set point_ref = oSel.Item(1).Value

  oSel.Clear

  Status = oSel.SelectElement2(iot2, "Select a line", False)

  msgbox oSel.Item(1).Type

  set line_ref = oSel.Item(1).Value

  oSel.Clear

'传递选定的点和线以创建新平面。 '使用法线方法创建平面。

  Dim hybridShapePlaneNormal1 As HybridShapePlaneNormal
  Set hybridShapePlaneNormal1 = hybridShapeFactory1.AddNewPlaneNormal(line_ref, point_ref)

  Dim bodies1 As Bodies
  Set bodies1 = NewPart1.Bodies

  Dim body1 As Body
  Set body1 = bodies1.Item("PartBody")

' This is where I get error

  body1.InsertHybridShape hybridShapePlaneNormal1  '{Error - Method InsertHybridShape failed}

  NewPart1.InWorkObject = hybridShapePlaneNormal1
  NewPart1.Update 



End Sub

Answer 1

我已将脚本简化为有效的内容。我怀疑你得到一个错误，因为你在产品的上下文中工作..在这种情况下，@ kantoku下面的答案使用复制粘贴特殊功能正确处理。在产品上下文中编写脚本部件更复杂一些。您可能需要nvl(to_char(info_type), 'null') 新插入的产品。无论如何，只在部件上下文中尝试以下代码（您需要创建一个部件和一些基本实体（例如一个立方体）：

activate

Answer 2

试一试：

'CreateLinkedPlane - vba
Option Explicit

Type ItemPart
    Item As AnyObject
    Part As Part
End Type

Sub CATMain()
    'ﾌﾟﾛﾀﾞｸﾄﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not IsProductDocument Then
        MsgBox "Please open the CATProduct File!!"
        End
    End If

    '点の選択
    Dim SelPoint As ItemPart
    SelPoint = SelectItem(VertexFilter, "Select a Point　/ [Esc]=Cancel")

    '線の選択
    Dim SelLine As ItemPart
    SelLine = SelectItem(StraightLineFilter, "Select a line　/ [Esc]=Cancel")

    'ﾘﾝｸ元点作成
    Dim Point As ItemPart
    Point = CreateHSExtract(SelPoint)

    'ﾘﾝｸ元線作成
    Dim Normal As ItemPart
    Normal = CreateHSExtract(SelLine)

    'Partの追加
    Dim NewPart As Part
    Set NewPart = AddNewPart

    'ﾘﾝｸﾍﾟｰｽﾄ
    Dim Items(2) As ItemPart
    Items(1) = Point
    Items(2) = Normal
    Dim Point_Normal_References As Collection
    Set Point_Normal_References = CopyPaste_ResultWithLink(Items, NewPart)

    '平面作成
    Call CreatePlane(Point_Normal_References(1), Point_Normal_References(2))

    '終わり
    MsgBox "Finish"
End Sub

'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
Private Function IsProductDocument() As Boolean
    On Error Resume Next
       Dim temp As ProductDocument
       Set temp = CATIA.ActiveDocument
       IsProductDocument = IIf(Err.Number = 0, True, False)
    On Error GoTo 0
End Function

'平面作成
Private Sub CreatePlane(PointRef As Reference, NormalRef As Reference)
    Dim WorkPart As Part
    Set WorkPart = GetPart(PointRef)

    Dim HSFact As HybridShapeFactory
    Set HSFact = WorkPart.HybridShapeFactory

    Dim HSPlaneNormal As HybridShapePlaneNormal
    Set HSPlaneNormal = HSFact.AddNewPlaneNormal(NormalRef, PointRef)

    Dim HBody As HybridBody
    Set HBody = WorkPart.HybridBodies.Add
    Call HBody.AppendHybridShape(HSPlaneNormal)
    Call WorkPart.UpdateObject(HSPlaneNormal)
End Sub

'ｺﾋﾟﾍﾟ
Private Function CopyPaste_ResultWithLink(Items() As ItemPart, TargetPart As Part) As Collection
    Dim Sel As Selection
    Set Sel = CATIA.ActiveDocument.Selection
    Dim i As Long
    With Sel
        .Clear
        For i = 1 To UBound(Items)
            Call .Add(Items(i).Item)
        Next
        .Copy
        .Clear
        Call .Add(TargetPart)
        Call .PasteSpecial("CATPrtResult")
        TargetPart.Update
        'ここでﾍﾟｰｽﾄしたｱｲﾃﾑ拾う
        Dim Refs As New Collection
        For i = 1 To .Count2
            Call Refs.Add(.Item2(i).Reference)
        Next
        .Clear
    End With
    Call ItemHide(TargetPart.HybridBodies.Item(1))
    Set CopyPaste_ResultWithLink = Refs
End Function

'Partの追加
Private Function AddNewPart() As Part
    Dim Dammy As Products
    Set Dammy = CATIA.ActiveDocument.Product.Products.AddNewComponent("Part", "")

    Dim Docs As Documents
    Set Docs = CATIA.Documents

    Set AddNewPart = Docs.Item(Docs.Count).Part
End Function

'抽出
Private Function CreateHSExtract(I_P As ItemPart) As ItemPart
    Dim Ref As Reference
    Set Ref = I_P.Part.CreateReferenceFromBRepName(GetBrepName(I_P.Item.Name), I_P.Item.Parent)

    Dim HSExtract As HybridShapeExtract
    Set HSExtract = I_P.Part.HybridShapeFactory.AddNewExtract(Ref)
    With HSExtract
        .PropagationType = 3
        .ComplementaryExtract = False
        .IsFederated = False
    End With

    Dim HBody As HybridBody
    Set HBody = I_P.Part.HybridBodies.Add
    HBody.Name = "ExportItem"
    Call ItemHide(HBody)

    Call HBody.AppendHybridShape(HSExtract)
    Call I_P.Part.UpdateObject(HSExtract)

    Dim ExtI_P As ItemPart
    Set ExtI_P.Item = HSExtract
    Set ExtI_P.Part = I_P.Part
    CreateHSExtract = ExtI_P
End Function

'Partの取得
Private Function GetPart(ByVal OJ As AnyObject) As Part
    Select Case TypeName(OJ.Parent)
        Case "Part"
            Set GetPart = OJ.Parent
        Case "Application"
            Set GetPart = Nothing
        Case Else
            Set GetPart = GetPart(OJ.Parent)
    End Select
End Function

'SelectElement用BrapName取得-thanks coe
Private Function GetBrepName(MyBRepName As String) As String
    MyBRepName = Replace(MyBRepName, "Selection_", "")
    MyBRepName = Left(MyBRepName, InStrRev(MyBRepName, "));"))
    MyBRepName = MyBRepName + ");WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)"
    GetBrepName = MyBRepName
End Function

'非表示
Private Sub ItemHide(Item As AnyObject)
    Dim Sel As Selection
    Set Sel = CATIA.ActiveDocument.Selection
    With Sel
        .Clear
        Call .Add(Item)
        Call .VisProperties.SetShow(catVisPropertyNoShowAttr)
        .Clear
    End With
    Set Sel = Nothing
End Sub

'選択
Private Function SelectItem(Filter, Msg As String) As ItemPart
    Dim Sel 'As selection
    Set Sel = CATIA.ActiveDocument.Selection

    With Sel
        .Clear
        If "Cancel" = .SelectElement2(Filter, Msg, False) Then
            Call MsgBox("Cancellation!")
            End
        End If

        Dim I_P As ItemPart
        Set I_P.Item = .Item(1).Value
        Set I_P.Part = GetPart(I_P.Item)
        If I_P.Part Is Nothing Then
            Call MsgBox("Cancellation!")
            End
        End If
        .Clear
    End With
    SelectItem = I_P
    Set Sel = Nothing
End Function

'SelectElement用直線ﾌｨﾙﾀｰ
Private Function StraightLineFilter() As Variant
    Dim Ary(1) As Variant
    Ary(0) = "RectilinearMonoDimFeatEdge"
    Ary(1) = "RectilinearTriDimFeatEdge"
    StraightLineFilter = Ary
End Function

'SelectElement用点ﾌｨﾙﾀｰ
Private Function VertexFilter() As Variant
    Dim Ary(0) As Variant
    Ary(0) = "Vertex"
    VertexFilter = Ary
End Function