Extracting geometrical set name of point to excel 2

[das583]

I have code that exports the name and coordinates of all points in folders that contain the word "STRUCTURE". The part I need now is to also extract the geometrical set name for each of these points which I have not been able to figure out.

Here is an example of what I need:

TEST.CATPart

BOB STRUCTURE

GeoSet2

GeoSet3

Point 1​

Point 2​

Point 3​

I then want to export to excel the GeoSet3 geometrical set name to excel for points 1,2,3.

So the data in excel would read as:
Point 1 | x-coord | y-coord | z-coord | GeoSet3
Point 2 | x-coord | y-coord | z-coord | GeoSet3
Point 3 | x-coord | y-coord | z-coord | GeoSet3

Here is the code I have so far:

Sub CATMain()

On Error Resume Next

Dim docPart As Document
Dim myPart As Part
Dim hybBodies As HybridBodies
Dim hybBody As HybridBody
Dim hybShapes As HybridShapes
Dim hybShape As HybridShape

Dim arrXYZ(2)
Dim s As Long
Const Separator As String = ";"

Set docPart = CATIA.ActiveDocument

Set MyWkBnch = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
'If no doc active
If Err.Number <> 0 Then
MsgBox "No Active Document", vbCritical
Exit Sub
End If


'Start Excel
'******************************************************************************
Err.Clear
On Error Resume Next
Set objGEXCELapp = GetObject(, "EXCEL.Application")

If Err.Number <> 0 Then
Err.Clear
Set objGEXCELapp = CreateObject("EXCEL.Application")
End If
objGEXCELapp.Application.Visible = True
Set objGEXCELwkBks = objGEXCELapp.Application.WorkBooks
Set objGEXCELwkBk = objGEXCELwkBks.Add
Set objGEXCELwkShs = objGEXCELwkBk.Worksheets(1)
Set objGEXCELSh = objGEXCELwkBk.Sheets(1)
objGEXCELSh.cells(1, "A") = "Name"
objGEXCELSh.cells(1, "B") = "X"
objGEXCELSh.cells(1, "C") = "Y"
objGEXCELSh.cells(1, "D") = "Z"

' What do you want to select - in this case a Geometrical Set
'Dim EnableSelectionFor(0)
'EnableSelectionFor(0) = "HybridBody"

' Reset the Selection
Set sSel = CATIA.ActiveDocument.Selection
sSel.Clear

AppActivate ("CATIA V5")

' Define Selection
'MsgBox "Please Select the Geometrical Set where you have the POINTS"
'userselection = sSel.SelectElement2(EnableSelectionFor, "Please select another Geometrical Set", False)
sSel.Search "(Name=*STRUCTURE* & CATPrtSearch.OpenBodyFeature),all"

' Evaluation if the selection is correct or not
'If userselection <> "Normal" Then
' MsgBox "Error with the selection"
' Exit Sub
'Else
' Set oHybridBody = sSel.Item(1).Value
'End If

Set oHybridBody = sSel.Item(1).Value
Set partDocument1 = CATIA.ActiveDocument
Dim selection1 As Selection
Set selection1 = partDocument1.Selection

selection1.Search "CATPrtSearch.Point,sel"

Dim part1 As Part
Set part1 = partDocument1.Part

Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies

Dim hybridBody1 As HybridBody

'***********************************************************************************************************************

For s = 1 To selection1.Count

'Set Measure = MyWkBnch.GetMeasurable(selection1.Item(s).Reference)

Set hybShape = selection1.Item(s).Value
Set hybShapes = hybBody.HybridShapes
'MsgBox hybShape.Name 'returns point name
'Extract coordinates
hybShape.GetCoordinates arrXYZ
Set hybridBody1 = hybridBodies1.Item(s).Value

objGEXCELSh.cells(s + 1, "A") = hybShape.Name
objGEXCELSh.cells(s + 1, "B") = arrXYZ(0)
objGEXCELSh.cells(s + 1, "C") = arrXYZ(1)
objGEXCELSh.cells(s + 1, "D") = arrXYZ(2)
objGEXCELSh.cells(s + 1, "E") = Geometrical Set of Point

Next s

objGEXCELSh.columns("A").autofit
objGEXCELSh.columns("E").autofit

AppActivate ("Microsoft Excel")

End Sub

I very much appreciate any help you can provide.

 

[itsmyjob]

try

objGEXCELSh.cells(s + 1, "E") = hybridBodies1.Item(s).Value.Parent.Parent.Name

Eric N.
indocti discant et ament meminisse periti ​

 

[das583]

I had to alter your code a bit to make it work but now it does. Thank you so much! Here is the line of code as I have updated it:

objGEXCELSh.cells(s + 1, "E") = hybShape.Parent.Parent.Name