Is it possible to insert the largest sphere possible inside of a selected model in CATIAV5 via a VBA macro?

Question

I am very new to CATIA V5,and by that i mean that i have no idea on how this program actually works. I've been asked if i could make a macro for CATIA. I would like to know if it is possible to write a VBA macro that when executed it will insert the largest sphere possible inside of the model that was opened

Since i don't know how CATIA actually works i also don't really know how the arguments are supposed to look like So i went to CHATGPT to see if i could get a taste of what it would be like to code a CATIA Macro and this is what i tried but with no success.

Sub InsertBiggestSphere()
    Dim partDocument As PartDocument
    Set partDocument = CATIA.ActiveDocument

    Dim part As Part
    Set part = partDocument.Part

    ' Call function to find the biggest possible sphere
    Dim center As Point, radius As Double
    FindBiggestSphere part, center, radius

    ' Create the sphere
    CreateSphere part, center, radius
End Sub

Sub FindBiggestSphere(part As Part, ByRef center As Point, ByRef radius As Double)
    ' Implement your algorithm to find the biggest possible sphere
    ' This may involve traversing the part's geometry and analyzing the dimensions
    
    ' For example, you can loop through all faces in the part to find the maximum
    ' distance between any two points. The center of the sphere will be the midpoint
    ' of the line connecting these two points, and the radius will be half of the distance.
    
    Dim bodies As Bodies
    Set bodies = part.Bodies
    Dim hybridBody As Body
    Set hybridBody = bodies.Item(1)  ' Assuming the first body is the one containing your faces
    
    Dim hybridShapes As HybridShapes
    Set hybridShapes = hybridBody.HybridShapes
    
    Dim maxDistance As Double
    Dim face1 As HybridShapeFaceExplicit
    Dim face2 As HybridShapeFaceExplicit
    
    For Each face1 In hybridShapes
        If TypeOf face1 Is HybridShapeFaceExplicit Then ' Check if it's a face
            For Each face2 In hybridShapes
                If TypeOf face2 Is HybridShapeFaceExplicit Then ' Check if it's a face
                    If face1 <> face2 Then
                        distance = CalculateDistance(face1.StartPoint, face2.EndPoint)
                        If distance > maxDistance Then
                            maxDistance = distance
                            center = CalculateMidPoint(face1.StartPoint, face2.EndPoint)
                            radius = distance / 2
                        End If
                    End If
                End If
            Next face2
        End If
    Next face1
End Sub

Sub CreateSphere(part As Part, center As Point, ByVal radius As Double)
    Dim hybridShapeFactory As HybridShapeFactory
    Set hybridShapeFactory = part.HybridShapeFactory

    ' Create the sphere
    Dim sphere As HybridShapeSphere
    Set sphere = hybridShapeFactory.AddNewSphere(center, radius)

    ' Update the part
    part.Update
End Sub

Function CalculateDistance(p1 As Point, p2 As Point) As Double
    Dim deltaX As Double
    Dim deltaY As Double
    Dim deltaZ As Double
    
    deltaX = p1.X - p2.X
    deltaY = p1.Y - p2.Y
    deltaZ = p1.Z - p2.Z
    
    CalculateDistance = Sqr(deltaX ^ 2 + deltaY ^ 2 + deltaZ ^ 2)
End Function

Function CalculateMidPoint(p1 As Point, p2 As Point) As Point
    Dim midPoint As Point
    midPoint.X = (p1.X + p2.X) / 2
    midPoint.Y = (p1.Y + p2.Y) / 2
    midPoint.Z = (p1.Z + p2.Z) / 2
    
    Set CalculateMidPoint = midPoint
End Function

I merely ask that someone points me in the right direction atleast. Thanks for Reading

Answer 1

I'm not sure To understand your need.. Actually your code try to get the envelopping sphere of the part, to find the maximum wall thickness you can follow this :

• get the part
• get the MainBody
• Select this body
• Find all faces inside this selection (thanks to function Select search topology,sel)
• loop for each face_1 (you Can filter by "PlanearFace" if you need)
  • loop for each face_2
    • use minimum distance function between face_1 and face_2
    • if distance>0 and IS the minimum distance found on this loop => it IS the thickness. Save this distance and these 2 faces in a variable (Can be a dictionary<double, face, face>).

Use your dictionary to find the maximum Key (distance) and draw the sphere in center of a face (Face_1 of your dictionary).

If it Can help.

---

EDITED According to coment of @Gonçalo:

---

You have now, no errors during compilation:

Sub CATMain()

    Set partDoc = CATIA.ActiveDocument
    Set mainBody = partDoc.part.mainBody
    
    Set sel = partDoc.Selection
    sel.Clear
    sel.Add mainBody
    sel.Search "Topology.Face;sel"
    
    Dim thickness As Double
    
    
    Dim j As Integer
    For j = 1 To sel.Count
        Dim surface As Face
        Set surface = sel.Item(j).Value
        
        If TypeOf surface Is PlanarFace Then
        
            Dim k As Integer
            For k = 1 To sel.Count
                Dim surface2 As Face
                Set surface2 = sel.Item(k).Value
                
                If TypeOf surface2 Is PlanarFace Then
                    
                    Dim spaWorkbench As spaWorkbench
                    Set spaWorkbench = partDoc.GetWorkbench("SPAWorkbench")
                    
                    Dim Measure As Measurable
                    Set Measure = spaWorkbench.GetMeasurable(surface)
                    
                    minDistance = Measure.GetMinimumDistance(surface2)
          
                    
                    If thickness = 0 Then
                        thickness = minDistance
                    Else
                        If minDistance < thickness Then
                        
                        '--------------
                        ' You have to continue this algorythm
                        '--------------
                    
                        End If
                    End If
                End If
            Next k
        End If
    Next j
    

    '-------------------
    ' This next code is not good but please end the first algorythm before trying to draw the sphere
    '------------------
    
  '  Dim sphereRadius As Double
  '  sphereRadius = maxDistance / 2
    
  '  Dim sphereCenter As Point
  '  Set sphereCenter = maxDistanceFace1.Centre
    
  '  Dim part As part
  '  Set part = partDoc.part
    
  '  Dim shapeFactory As shapeFactory
  '  Set shapeFactory = part.shapeFactory
    
  '  Dim Sphere
  '  Set Sphere = shapeFactory.AddNewSphere(sphereCenter, sphereRadius)
    
    partDoc.part.Update


End Sub