J'essaye de créer une esquisse positionnée dans CATIA. Mais je suis coincé sur la création d'avion. ci-dessous dans mon code avec la ligne d'erreur marquée

Question

J'ai marqué la ligne sur laquelle une erreur se produit.

Language = "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 

'variables pour choisir le point et le bord

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 

' passe le point et la ligne choisie pour créer un nouveau plan. 'Le plan est créé en utilisant la méthode normale à la courbe.

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

Essayez:

'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 

Answer 2

J'ai simplifié votre script à quelque chose qui fonctionne. Je soupçonne que vous obtenez une erreur parce que vous travaillez dans le contexte d'un produit .. Dans ce cas, la réponse ci-dessous de @kantoku gère correctement avec la fonction spéciale copier-coller. La création de scripts dans un contexte de produit est un peu plus compliquée. Vous devrez peut-être activate votre produit nouvellement inséré. Quoi qu'il en soit, essayez ce code ci-dessous dans un contexte partiel seulement (vous devrez créer une partie et une solide base (un cube par exemple):

Option Explicit 
Sub MakePointOnPlane() 

Dim partDoc As PartDocument 
Dim oSel 
Dim status 
Dim myPart As Part 
Dim HSF As HybridShapeFactory 

Set partDoc = CATIA.ActiveDocument 
Set oSel = partDoc.Selection 
Set myPart = partDoc.Part 
Set HSF = myPart.HybridShapeFactory 

Dim point_ref 
Dim line_ref 
Dim Point As Reference 
Dim Line As Reference 
'Variables to pick point and edge 

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

    status = oSel.SelectElement2(iot1, "Select a vertex", 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 
' Passing selected point and line to create a new plane. ' The plane is created using method normal to curve. 

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

    Dim body1 As Body 

    Set body1 = myPart.Bodies.GetItem("PartBody") 

    Dim myPlane As Variant 
    Set myPlane = hybridShapePlaneNormal1 
    body1.InsertHybridShape hybridShapePlaneNormal1 
    myPart.InWorkObject = hybridShapePlaneNormal1 
    myPart.Update 



End Sub