thread560-438183
Below is working great for point extraction, name, and parent name, so long as there is no child geo-sets within a geoset. I have sub-parent geoset names (children) that I need to identify as well in an adjacent column. Is this possible?
Below is working great for point extraction, name, and parent name, so long as there is no child geo-sets within a geoset. I have sub-parent geoset names (children) that I need to identify as well in an adjacent column. Is this possible?
Code:
Sub CATMain()
Set objexcel = CreateObject("Excel.Application")
objexcel.Visible = True
Set objWorkbook = objexcel.Workbooks.Add()
Set objsheet1 = objWorkbook.Sheets.Item(1)
objsheet1.Name = "Points_Coordinates"
Dim coords(2) As Variant
Set Selection = CATIA.ActiveDocument.Selection
Selection.Search "( CATPrtSearch.Point),all"
For I = 1 To Selection.Count
Set Element = Selection.Item(I)
Set Point = Element.Value
Point.GetCoordinates (coords)
objsheet1.cells(I + 1, 1).Value = Point.Name
objsheet1.cells(I + 1, 2).Value = coords(0)
objsheet1.cells(I + 1, 3).Value = coords(1)
objsheet1.cells(I + 1, 4).Value = coords(2)
'objsheet1.cells(I + 1, 5).Value = Element.Name
'this is for non-isolated Points
Set ParentObject = Point.Parent
Do
If TypeName(ParentObject) = "HybridBody" Or TypeName(ParentObject) = "Body" Then
objsheet1.cells(I + 1, 5).Value = ParentObject.Name
Exit Do
Else
Set ParentObject = ParentObject.Parent
End If
'safe check
If TypeName(ParentObject) = "Part" Then
Exit Do 'you've went to far up and reached the Part itself.
End If
Loop
'this is for isolated points
If objsheet1.cells(I + 1, 5).Value = "" Then
bFound = False
Set oPart = CATIA.ActiveDocument.Part
'temporarily rename the point so the proper point is retrieved.
tmpPointName = "tmpPoint." & I
Point.Name = tmpPointName
For ix = 1 To oPart.HybridBodies.Count
Set oMyHBody = oPart.HybridBodies.Item(ix)
For jx = 1 To oMyHBody.HybridShapes.Count
Set oHShape = oMyHBody.HybridShapes.Item(jx)
If oHShape.Name = tmpPointName Then
'this is my Point. get the parent's name
objsheet1.cells(I + 1, 5).Value = oMyHBody.Name
bFound = True
Exit For
End If
Next
If bFound Then Exit For
Next