Prezados, comecei a desenvolver um código VBA que deve: 1- pedir para o usuário selecionar uma face de qualquer corpo no CATPART atual. 2- uma vez feito isso, o VBA deve extrair essa superfície em um conjunto geométrico e criar 3 pontos no contorno dessa superfície. 3- com base nesses pontos, criar um plano e, por fim, projetar o contorno da superfície dentro de um esboço.
abaixo do meu código, não funciona. Ele exibe incompatibilidade de tipo sem especificar onde.
A imagem descreve mais ou menos o que eu quero. NB: a parte do gato pode conter formas complexas, por isso a superfície extraída precisa estar em tangência
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