×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Extracting geometrical set name of point to excel

Extracting geometrical set name of point to excel

Extracting geometrical set name of point to excel

(OP)
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.

RE: Extracting geometrical set name of point to excel

try

CODE --> vba

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

Eric N.
indocti discant et ament meminisse periti

RE: Extracting geometrical set name of point to excel

(OP)
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

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources