Von selektiertem Grafikobjekt (3D Bereich) zu Baumobjekt (Dassault Systemes - PLM Solutions/CATIA V5 Programmierung)

Hallo zusammen,

ich habe mir ein Makro geschrieben, um die selektierten Objekte umzubenennen. Wenn ich allerdings im Grafikbereich etwas auswähle, dann bekomme ich folgende Ausgabe von diesem Makro:

Code:
17;13);None:(Limits1:();Limits2:();+1);Cf11:());Sketch.17;Z0;G6721)
name type ZeroDimFeatVertexOrWireBoundaryMonoDimFeatVertex
name before Selection_BorderFVertex:(BEdge:(Brp:(Sketch.17;13);None:(Limits1:();Limits2:();+1);Cf11:());Sketch.17;Z0;G6721)
name after ZeroDimFeatVertexOrWireBoundaryMonoDimFeatVertex.17;13);None:(Limits1:();Limits2:();+1);Cf11:());Sketch.17;Z0;G6721)

Meine Frage wäre nun, wie komme ich von einem selektierten Objekt im Grafikbereich zu dem entsprechenden Feature im Baum?
Beispiel: Ich selektiere einen Vertex von einem Sketch, will im Makro aber auf den Sketch zugreifen, um diesen umzubenennen. Den Vertex allein kann ich ja nicht umbenennen.

Code:
Sub CATMain()
'Sub RenameSelectedFeatures()
'Rename selected Features with promped name
'following References are needed
'Tools - References... - Microsoft Scripting Runtime
Dim i As Integer
Dim feature_name As String
Dim type_name As String
Dim type_count As String
Dim point_pos As Integer
Dim obj_sel As Selection
Set obj_sel = CATIA.ActiveDocument.Selection

Dim dict As Scripting.Dictionary
Set dict = New Scripting.Dictionary
'speed up the macro execution
CATIA.RefreshDisplay = False
CATIA.Application.DisplayFileAlerts = False
CATIA.HSOSynchronized = False

If obj_sel.Count > 0 Then
'count the types of the selection
For i = 1 To obj_sel.Count
type_name = TypeName(obj_sel.Item(i).Value)
If dict.Exists(type_name) Then
dict(type_name) = dict(type_name) + 1
Else
dict.Add Key:=type_name, Item:=1
End If
Next i

'store only key value pairs where more than one is in the selection
For Each Key In dict.Keys
If dict(Key) = 1 Then
dict.Remove Key
Else
dict(Key) = 1
End If
Next Key

'do the renaming
For i = 1 To obj_sel.Count
'get the predefined name of the selection
If i = 1 Then
feature_name = obj_sel.Item(i).Value.Name

point_pos = InStr(1, feature_name, ".")

If point_pos Then
feature_name = Mid(feature_name, point_pos + 1)
End If

Debug.Print feature_name

feature_name = InputBox("Enter the feature name.", "Feature Name", feature_name)
If feature_name = "" Then
Exit Sub
End If
End If

type_name = obj_sel.Item(i).Type

'increase type counter
If dict.Exists(type_name) Then
type_count = dict(type_name)
dict(type_name) = dict(type_name) + 1
Else
type_count = 0
End If

'rename internal names to displayed names
Select Case type_name
Case "AxisSystem"
type_name = "Axis System"
Case "HybridShapeAssemble"
type_name = "Join"
Case "HybridShapeLoft"
type_name = "Multi-sections Surface"
Case "HybridBody"
type_name = ""
End Select

'adjust the type_name where "HybridShape" is in front of the name
If Left(type_name, 11) = "HybridShape" Then
type_name_length = Len(type_name)
If type_name_length > 12 Then
For x = 13 To type_name_length
If UCase(Mid(type_name, x, 1)) = Mid(type_name, x, 1) Then
type_name = Mid(type_name, 12, x - 12)
Exit For
ElseIf x = type_name_length Then
type_name = Mid(type_name, 12)
Exit For
End If
Next x
End If
End If

'add counter only for types where more than one in the selection
If type_count > 0 And Len(type_name) Then
name_complete = type_name & "." & feature_name & " " & type_count
ElseIf type_count = 0 And Len(type_name) Then
name_complete = type_name & "." & feature_name
Else
name_complete = feature_name
End If

Debug.Print "name type " & obj_sel.Item(i).Type
Debug.Print "name before " & obj_sel.Item(i).Value.Name
Debug.Print "name after " & name_complete & vbCrLf

'rename it finally
obj_sel.Item(i).Value.Name = name_complete
Next
Else
MsgBox "Select at least one feature."
End If

Set obj_sel = Nothing

'reset the values
CATIA.RefreshDisplay = True
CATIA.Application.DisplayFileAlerts = True
CATIA.HSOSynchronized = True

End Sub

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP