Extract special coordinates

[AtomicNico]

Hello, that's me again but for another question

I got some pipes where I need to extract some special coordinates.
I'm attaching a file to show what kind of pipes I have.
For the T, I need to extract the origin coordinates, the end coordinates and the branch coordinates.
For the other one, I would like to extract the intersection of the neutral fibers.

How can I make that?

Moreover, how can I extract the diameter?

Best regards

 

[tesak]

Radius is Long, not Object variable, so do not use Set keyword, just

Dim radius As double
radius = NewMeasurable.Radius

Tesak

http://scripts4all.eu/txtoncurve/

- Curved text for Catia V5

 

[AtomicNico]

Ok thank you, works perfectly now!

 

[AtomicNico]

I got a little problem with my loop: on multiple selections, I only got the 1st element selected which gives me the results but after I got an error "Coordinates: type non compatible", so either I've got a problem in my loop or the selection method is wrong.

Sub CATMain()

    Dim intNbEdges As Integer
    Dim doc, sel, spa, ref, measurable
    Dim inputObjectType(0)
    Dim i As Integer
    
    Set doc = CATIA.ActiveDocument
    Set sel = doc.selection
    Set spa = doc.GetWorkbench("SPAWorkbench")
 
    'Selection of circular edge
    inputObjectType(0) = "TriDimFeatEdge"
    Status = sel.SelectElement3(inputObjectType, "Select the edge", True, CATMultiSelTriggWhenUserValidatesSelection, True)
    If (Status = "cancel") Then Exit Sub
  
  intNbEdges = sel.Count

  For i = 1 To intNbEdges

  Set ref = sel.Item(i).Reference
  Set measurable = spa.GetMeasurable(ref)
  
    Dim Coordinates(2)
    measurable.GetCenter Coordinates
    Dim Radius As Long
    Radius = measurable.Radius
    
    MsgBox "x = " & Coordinates(0) & " ; y = " & Coordinates(1) & " ; z = " & Coordinates(2) & " ; radius = " & Radius

    Next

End Sub

Moreover: the selection palette is useful but it doesn't take the TriDimFeatEdge with the selection palette. How can I make it automatically?
I thought about a objGCATIASelection0.Search "(CATLndSearch.TriDimFeatEdge),all" but it doesn't seem to work

 

[itsmyjob]

do you actually select a circular edge (planar)?

Eric N.
indocti discant et ament meminisse periti ​

 

[AtomicNico]

Yes, the inputObjectType(0) = "TriDimFeatEdge" only allows me to select circular edges, I tried it on several models.
I presume the error is in the loop but where is the question... Do I need to reinitialize one of the variables? Like coordinates?

 

[itsmyjob]

i was able to select not planar edge with your code. I had problem only if I selected an edge that was not a circle.

Eric N.
indocti discant et ament meminisse periti ​

 

[itsmyjob]

this s where you can use on error resume next / on error goto 0

Eric N.
indocti discant et ament meminisse periti ​

 

[AtomicNico]

But when I select all the edges of my part one at a time, there won't be any problem, and on this part I'm sure all I have are circular edges (start and end of a pipe).
If I put a "on error goto 0", I will have to make a new selection, right?

 

[itsmyjob]

the on error goto 0 is here to cancel on error resume next.

so when you have something like an edge curve and want the circle center. you know circle center will fail if edge curve is not a circle so you do:

for i = 1 to x
    on error resume next
    create center point of edge (assuming it's a circle)
    if err.level <>0 then edge is not circle  but system continue (resume next)
    if err.level = 0 then point is created = edge is circle
    on error goto 0   ' this will bring err.level to 0 and stop script if any error is found = back to normal behavior.
next

Eric N.
indocti discant et ament meminisse periti ​

 

[AtomicNico]

Yes! It works! Thanks Eric!

For the selection, do you have an idea about why the edges are not selected by the Tools Palette? I can't find anything about it on internet.

Also, I tried to automatize it, making a selection by the edges, but the command I tried (sel.Search "(CATLndSearch.TriDimFeatEdge),all" ) does not work that way. Do you have an idea about it?
The macro makes a selection of the part, then find all the edges and extract the wanted datas of all edges

 

[AtomicNico]

I'm still stuck on my problem of edges so I have to ask again, but in a better way:
Does anyone knows what are the items selected by the tools palette when you make

Status = sel.SelectElement3(inputObjectType, "Select the edge", True, CATMultiSelTriggWhenUserValidatesSelection, False)

?
Because I can select the edges when I click on it but it's not included in the selection trap.

Same type of question with the command

sel.Search "(CATLndSearch.Product),all"

How can I replace the .Product in a way that includes the edges? .TriDimFeatEdge doesn't seem to be good.

I'm sorry to ask here again but I can't find those informations in the automation doc nor on the web

 

[AtomicNico]

I tried a new way to do it but it failed, maybe you can tell me where is the error.

I tried "sel.Search("Type=TriDimFeatEdge, all")" but Method Search failed. So I wanted to add TriDimFeatEdge as a new support of search.
In automation it says that Add method will take an AnyObject, but when I wrote CATIA.ActiveDocument.Selection.Add(TriDimFeatEdge), still not working.
Do I have to put some line before? I know it's this hierarchy: AnyObject => Reference => Boundary => Edge => TriDimFeatEdge

 

[AtomicNico]

Ok, I found how to do it:
- Selection of all the edges with sel.Search "Topology.CGMEdge,all"
- Selection of only the TriDimFeatEdge

 

[AtomicNico]

Hey guys, likely the last time I'm asking you something but I need a little help again
Here is my loop to select the edges, that works alone

Sub CATMain()

    Dim intNbEdges As Integer
    Dim doc, sel, spa, ref, measurable
    Dim inputObjectType(0)
    Dim i As Integer
  
    Set doc = CATIA.ActiveDocument
    Set sel = doc.Selection
    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
            
             Err.Clear
    End If
    Next

End Sub

And I've got my first macro that will select the pieces, which is this one:

 '//---------- Get current selection & root product
  Set objGCATIASelection1 = objGCATIADocument0.Selection
  Set objGCATIAProduct1 = objGCATIADocument0.Product

  If objGCATIASelection1.Count = 0 Then
    objGCATIASelection1.Search "(CATLndSearch.Product),all"
  End If

  Err.Clear


  Dim objProduct As Product
  Dim objProductMat As Product
  Dim intNbParts As Integer
  Dim k As Integer

  intNbParts = objGCATIASelection1.Count

  For k = 1 To intNbParts
    Set objProduct = Nothing
    Set objProductMat = Nothing

    Set objProduct = objGCATIASelection1.Item(k).Value
    Set objProductMat = objGCATIASelection1.Item(k)

    Err.Clear

    Dim objInertia As Inertia
    'On Error Resume Next
    Set objInertia = objProduct.GetTechnologicalObject("Inertia")
    Dim getMass As String
    getMass = objInertia.Mass
    Dim partName As String
    partName = objProduct.Name
    Dim Mat As Material
    Dim oManager As MaterialManager
    Set oManager = objProductMat.Item(k).GetItem("CATMatManagerVBExt")
    oManager.GetMaterialOnPart objProductMat.ReferenceProduct.Parent.Part,Mat
    matName = Mat.Name
    'MsgBox matName
    Dim Coordinates(2)
    objInertia.GetCOGPosition Coordinates

      intGReportCurrentRow = intGReportCurrentRow + 1
      InsertAnEXCELRowAt (intGReportCurrentRow)

      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleMass, getMass
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitlePartName, partName
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleMaterial, matName
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGX, Coordinates(0) & "mm"
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGY, Coordinates(1) & "mm"
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGZ, Coordinates(2) & "mm"

    Next

    intGReportCurrentRow = intGReportCurrentRow + 1
    InsertAnEXCELRowAt (intGReportCurrentRow)

But when I put the 1st one into the 2nd one, I don't succeed:

Sub CATMain()

  Dim objProduct As Part
  Dim objProductMat As Part
  Dim intNbParts As Integer
  Dim i As Integer
    Dim intNbEdges As Integer
    Dim doc, sel, spa, ref, measurable
    Dim inputObjectType(0)
    Dim j As Integer

  StartCATIA
  If Err.Number <> 0 Then
    Exit Sub
  End If

  StartEXCEL
  If Err.Number <> 0 Then
    Exit Sub
  End If

  Set objGCATIASelection0 = objGCATIADocument0.Selection
  Set objGCATIAProduct0 = objGCATIADocument0.Product

  If objGCATIASelection0.Count = 0 Then
    objGCATIASelection0.Search "(CATLndSearch.Part),all"
  End If

  intNbParts = objGCATIASelection0.Count

  For i = 1 To intNbParts
    Set objProduct = Nothing
    Set objProductMat = Nothing

    Set objProduct = objGCATIASelection0.Item(i).Value
    Set objProductMat = objGCATIASelection0.Item(i)

    Err.Clear
    'On Error Resume Next

    Dim objInertia As Inertia
    On Error Resume Next
    Set objInertia = objProduct.GetTechnologicalObject("Inertia")
    Dim getMass As String
    getMass = objInertia.Mass
    Dim partName As String
    partName = objProduct.Name
    'Dim Mat As Material
    'Dim oManager As MaterialManager
    'Set oManager = objProductMat.GetItem("CATMatManagerVBExt")
    'oManager.GetMaterialOnPart objProductMat.ReferenceProduct.Parent.Part,Mat
    'matName = Mat.Name
    Dim Coordinates(2)
    objInertia.GetCOGPosition Coordinates
  
    Set sel = CATIA.ActiveDocument.Item(i)
    Set spa = doc.GetWorkbench("SPAWorkbench")

'// Now for the second loop

    sel.Search "Topology.CGMEdge,all"
    intNbEdges = sel.Count
MsgBox intNbEdges
    For j = 1 To intNbEdges
  
        Set myCircle = sel.Item(j)
        If myCircle.Type = "TriDimFeatEdge" Then
              
             Set ref = sel.Item(j).Reference
             Set measurable = spa.GetMeasurable(ref)
             Dim oCoordinates(2)
             measurable.GetCenter oCoordinates
             Dim Radius As Long
             Radius = measurable.Radius
             
             MsgBox "x = " & oCoordinates(0) & Chr(10) & "y = " & oCoordinates(1) & Chr(10) & "z = " & oCoordinates(2) & Chr(10) & "Diametre = " & 2 * Radius
            
             Err.Clear
    End If
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepX, oCoordinates(0) & "mm"
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepY, oCoordinates(1) & "mm"
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepZ, oCoordinates(2) & "mm"

    Next

      intGReportCurrentRow = intGReportCurrentRow + 1
      InsertAnEXCELRowAt (intGReportCurrentRow)

      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleMass, getMass
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleMaterial, matName
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGX, Coordinates(0) & "mm"
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGY, Coordinates(1) & "mm"
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGZ, Coordinates(2) & "mm"
      'WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepX, oCoordinates(0) & "mm"
      'WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepY, oCoordinates(1) & "mm"
      'WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepZ, oCoordinates(2) & "mm"
      WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitlePartName, partName

Next
    intGReportCurrentRow = intGReportCurrentRow + 1
    InsertAnEXCELRowAt (intGReportCurrentRow)

End Sub '/////////////////////////////////////////////////////////// CATMain

I'm guessing it's about the selection "sel" which is likely wrong because the MsgBox intNbEdges shows up empty.