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
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
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