Welcome to 3DCADForums

Join our CAD community forums where over 25,000 users interact to solve day to day problems and share ideas. We encourage you to visit, invite you to participate and look forward to your input and opinions. Acrobat 3D, AutoCAD, Catia, Inventor, IronCAD, Creo, Pro/ENGINEER, Solid Edge, SolidWorks, and others.

Register Log in

Help for Macro


New member
Hello guys, I'm in need for a little help!

I'm actually writing a macro but it does'nt work the way I'd want it.

What I want: I have an assembly with multiple parts in it, I want to make a selection of all the parts automatically, then, inside each item of the selection, that it makes a selection of the edges of the item.

How I wrote it at the moment:
Sub CATMain()

Dim NbParts As Integer
Dim CATDoc As Document
Dim CATSel As Selection
Dim CATProduct As Product
Dim j As Integer

Set CATDoc = CATIA.ActiveDocument
Set CATSel = CATDoc.Selection
Set CATProduct = CATDoc.Product
If CATSel.Count = 0 Then                       
  CATSel.Search "(CATLndSearch.Part),all"     ' since I don't make a selection at first, selection of all the parts
End If

NbParts = CATSel.Count

For j = 1 To NbParts
    Dim intNbEdges As Integer
    Dim doc, sel, spa, ref, measurable
    Dim inputObjectType(0)
    Dim i As Integer
    Set doc = CATIA.ActiveDocument
    Set sel = CATSel.Item(j)
    Set spa = doc.GetWorkbench("SPAWorkbench")
    sel.Search "Topology.CGMEdge,all"
    intNbEdges = sel.Count
MsgBox intNbEdges

    For i = 1 To intNbEdges
        Set myCircle = sel.Item(i)
        If myCircle.Type = "TriDimFeatEdge" Then

             On Error Resume Next 
             Set ref = sel.Item(i).Reference
             Set measurable = spa.GetMeasurable(ref)
             Dim Coordinates(2)
             measurable.GetCenter Coordinates
             Dim Radius As Long
             Radius = measurable.Radius
            On Error Goto 0

             MsgBox "x = " & Coordinates(0) & Chr(10) & "y = " & Coordinates(1) & Chr(10) & "z = " & Coordinates(2) & Chr(10) & "Diametre = " & 2 * Radius & "PartName = " & CATProduct.Name
    End If
End Sub
Either it takes the whole assembly, or it won't take anything because it doesn't work.
Does anybody have an idea?

Best Regards