vbacatia

Project Body Faces Into Sketch


Dears, I have start to develop a VBA code, that should: 1- ask user to select a face from any bodies in the current CATPART. 2- once done VBA should extract that surface in a geometrical set and create 3 points on the contour of that surface. 3- based on these points, create a Plan and lastly project that surface contour inside a sketch.

below my code, it doesn't work. it displays type mismatch without specify were .

picture describe more or less what I want. NB: the catpart may contain complex shape, that's way the extracted surface needs to be in tangency

enter image description here

Sub ExtractSurfaceAndCreateSketch()
    Dim partDocument As Object
    Dim part1 As Object
    Dim selection1 As Object
    Dim face1 As Object
    Dim hybridShapeFactory As Object
    Dim hybridBody As Object
    Dim reference1 As Object
    Dim hybridShapeExtract As Object
    Dim hybridShapePoint As Object
    Dim sketch As Object
    Dim sketches As Object

    ' Initialize CATIA Document and Part
    Set partDocument = CATIA.activeDocument
    Set part1 = partDocument.part
    Set selection1 = partDocument.selection
    
    ' Clear previous selections
    selection1.Clear
    
    ' Prompt user to select a face
    MsgBox "Please select a face from a body."
    
    ' Select the face
    On Error Resume Next
    Dim result As Variant
    result = selection1.SelectElement2("Face", "Select a face", False)
    If Err.Number <> 0 Then
        MsgBox "Error during selection: " & Err.Description
        Err.Clear
        Exit Sub
    End If
    On Error GoTo 0
    
    ' Check the type of the result and compare accordingly
    If VarType(result) = vbString Then
        If result <> "Normal" Then
            MsgBox "No valid face selected. Exiting."
            Exit Sub
        End If
    Else
        MsgBox "Unexpected return type from SelectElement2. Exiting."
        Exit Sub
    End If
    
    ' Get the selected face
    If selection1.Count = 0 Then
        MsgBox "No face selected. Exiting."
        Exit Sub
    End If
    Set face1 = selection1.Item(1).Value
    
    ' Create a reference from the face
    On Error GoTo ErrorHandler
    Set reference1 = part1.CreateReferenceFromBRepName(face1.brepName)
    
    ' Create the Hybrid Shape Factory and Hybrid Body
    Set hybridShapeFactory = part1.hybridShapeFactory
    Set hybridBody = part1.hybridBodies.Add
    
    ' Extract the surface from the face
    Set hybridShapeExtract = hybridShapeFactory.AddNewExtract(reference1)
    hybridShapeExtract.Name = "ExtractedSurface"
    hybridBody.AppendHybridShape hybridShapeExtract
    
    ' Create points on the outline of the extracted surface
    Dim posX As Variant, posY As Variant
    Dim pointArray(2) As Object
    
    ' Define UV coordinates for point placement
    posX = Array(0.1, 0.5, 0.9) ' X coordinates
    posY = Array(0.1, 0.5, 0.9) ' Y coordinates
    
    Dim i As Integer
    For i = 0 To 2
        ' Create a point on the extracted surface using UV coordinates
        Set hybridShapePoint = hybridShapeFactory.AddNewPointOnSurface(reference1, posX(i), posY(i))
        hybridBody.AppendHybridShape hybridShapePoint
        Set pointArray(i) = hybridShapePoint ' Store the points for plane creation
    Next i
    
    ' Create a plane based on the three points
    Dim hybridShapePlane As Object
    Set hybridShapePlane = hybridShapeFactory.AddNewPlaneThroughPoints(pointArray(0), pointArray(1), pointArray(2))
    hybridBody.AppendHybridShape hybridShapePlane
    
    ' Create a sketch on the new plane
    Set sketches = part1.sketches
    Set sketch = sketches.Add(hybridShapePlane)
    
    ' Extract the projected profile of the extracted surface
    Dim projectedProfile As Object
    Set projectedProfile = hybridShapeFactory.AddNewProjection(hybridShapeExtract, hybridShapePlane)
    projectedProfile.Name = "ProjectedProfile"
    hybridBody.AppendHybridShape projectedProfile
    
    ' Set the sketch as editable
    Dim sketcherEditor As Object
    Set sketcherEditor = sketch.OpenEdition()
    
    ' Create lines based on the projected profile
    Dim iCurve As Integer
    Dim profile As Object

    ' Loop through all segments of the projected profile
    For iCurve = 1 To projectedProfile.Profiles.Count
        ' Get the profile curve
        Set profile = projectedProfile.Profiles.Item(iCurve)

        ' If it's a line, extract its start and end points
        If profile.Type = "Line" Then
            Dim startPoint As Object
            Dim endPoint As Object
            
            ' Retrieve the start and end points
            Set startPoint = profile.GetStartPoint()
            Set endPoint = profile.GetEndPoint()
            
            ' Create a line in the sketch using the Factory2D
            Dim factory2D As Object
            Set factory2D = sketcherEditor.factory2D
            
            ' Create the line in the sketch
            On Error Resume Next
            factory2D.CreateLine startPoint.X, startPoint.Y, endPoint.X, endPoint.Y
            If Err.Number <> 0 Then
                MsgBox "Error creating line: " & Err.Description
                Err.Clear
            End If
            On Error GoTo 0
        End If
    Next iCurve
    
    ' Close the sketch edition
    sketch.CloseEdition
    
    ' Update the part
    part1.Update
    
    MsgBox "Surface extracted, points created, plane established, and sketch projected successfully!"

    Exit Sub

ErrorHandler:
    MsgBox "Error: " & Err.Description
    Exit Sub
End Sub

Solution

  • You can project the face/extract directly into the sketch, so no additional projection and creating of lines is necessary.
    Here a shorter example. I used one of the OriginElement for the sketch.

    Sub CATMain()
        Dim partDocument As PartDocument
        Dim part1 As Part
        Dim selection1 As Selection
        Dim hybridShapeFactory As Object
        Dim hybridBody As hybridBody 
        Dim reference1 As Reference
        Dim hybridShapeExtract As hybridShapeExtrac
        Dim sketch As Sketch
        Dim sketches As Sketches
        Dim InputObjectType(0)
        Dim Result as String
    
        ' Initialize CATIA Document and Part
        Set partDocument = CATIA.activeDocument
        Set part1 = partDocument.part
        Set selection1 = partDocument.selection
        
        ' Clear previous selections
        selection1.Clear
    
        ' Select the face
        InputObjectType(0)="PlanarFace" 
        result = selection1.SelectElement2(InputObjectType, "Select a face", False)
        
        ' Check the type of the result and compare accordingly
        If result <> "Normal"  Then
            MsgBox "No valid face selected. Exiting."
            Exit Sub
        End If
        
        ' Get the selected face
        If selection1.Count = 0 Then
            MsgBox "No face selected. Exiting."
            Exit Sub
        End If
    
        ' Create a reference from the face
        Set reference1 = selection1.Item(1).Reference
        
        ' Create the Hybrid Shape Factory and Hybrid Body
        Set hybridShapeFactory = part1.hybridShapeFactory
        Set hybridBody = part1.hybridBodies.Add
        
        ' Extract the surface from the face
        Set hybridShapeExtract = hybridShapeFactory.AddNewExtract(reference1)
        hybridShapeExtract.Name = "ExtractedSurface"
        hybridBody.AppendHybridShape hybridShapeExtract
        part1.Update
        
        ' Create a sketch on on YZ plane
        Set oRefPlane = part1.OriginElements.PlaneYZ
        Set sketches = hybridBody.HybridSketches
        Set sketch = sketches.Add(oRefPlane)
    
        ' Open the sketch
        Dim factory2D As Object
        Set factory2D = sketch.OpenEdition()
    
        'project extract in sketch
        Dim oProjection
        Set oProjection = factory2D.CreateProjection(hybridShapeExtract)
        
        ' Close the sketch edition
        sketch.CloseEdition
        
        ' Update the part
        part1.Update
        
        MsgBox "Surface extracted and sketch projected successfully!"
    
    End Sub