rhooshchow
New member
Hi, I have a code that exports the name and coordinate of all points and its the geometrical set and part name along with it. However, the name of the geometrical does not appear correctly if the point is isolated, and i cant figure out how to solve for this.
Example of tree diagram:
TEST.CATPart
---GeoSet2
------Point 1
Data in Excel that i got:
Point 1 | x-coord | y-coord |z-coord | Parameters | Test
Data in Excel that i need:
Point 1 | x-coord | y-coord |z-coord | GeoSet2 | Test
Here is the code i have so far:
Sub CATMain()
On Error Resume Next
Dim hybBodies As HybridBodies
Dim hybBody As HybridBody
Dim hybShapes As HybridShapes
Dim hybShape As HybridShape
Dim arrXYZ(2)
Dim s As Long
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"
objGEXCELSh.cells(1, "E") = "Geometrical Set"
objGEXCELSh.cells(1, "F") = "Part"
'Export to Excel
'******************************************************************************
Set partDocument1 = CATIA.ActiveDocument
Dim selection1 As Selection
Set selection1 = partDocument1.Selection
selection1.Search "CATPrtSearch.Point,sel"
For s = 1 To selection1.Count
Set hybShape = selection1.Item(s).Value
hybShape.GetCoordinates arrXYZ
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") = hybShape.Parent.name
objGEXCELSh.cells(s + 1, "F") = hybShape.Parent.Parent.name
Next s
objGEXCELSh.columns("A").autofit
objGEXCELSh.columns("B").autofit
objGEXCELSh.columns("C").autofit
objGEXCELSh.columns("D").autofit
objGEXCELSh.columns("E").autofit
objGEXCELSh.columns("F").autofit
AppActivate ("Microsoft Excel")
End Sub
Any help you can provide is very much appreciated!!
Example of tree diagram:
TEST.CATPart
---GeoSet2
------Point 1
Data in Excel that i got:
Point 1 | x-coord | y-coord |z-coord | Parameters | Test
Data in Excel that i need:
Point 1 | x-coord | y-coord |z-coord | GeoSet2 | Test
Here is the code i have so far:
Sub CATMain()
On Error Resume Next
Dim hybBodies As HybridBodies
Dim hybBody As HybridBody
Dim hybShapes As HybridShapes
Dim hybShape As HybridShape
Dim arrXYZ(2)
Dim s As Long
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"
objGEXCELSh.cells(1, "E") = "Geometrical Set"
objGEXCELSh.cells(1, "F") = "Part"
'Export to Excel
'******************************************************************************
Set partDocument1 = CATIA.ActiveDocument
Dim selection1 As Selection
Set selection1 = partDocument1.Selection
selection1.Search "CATPrtSearch.Point,sel"
For s = 1 To selection1.Count
Set hybShape = selection1.Item(s).Value
hybShape.GetCoordinates arrXYZ
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") = hybShape.Parent.name
objGEXCELSh.cells(s + 1, "F") = hybShape.Parent.Parent.name
Next s
objGEXCELSh.columns("A").autofit
objGEXCELSh.columns("B").autofit
objGEXCELSh.columns("C").autofit
objGEXCELSh.columns("D").autofit
objGEXCELSh.columns("E").autofit
objGEXCELSh.columns("F").autofit
AppActivate ("Microsoft Excel")
End Sub
Any help you can provide is very much appreciated!!