Option Explicit ON
'zeigt das iProperty "Bezeichnung" bzw. intern "Description" 
'als ClientGraphics im Modellfenster 
' KraBBy 2024-01-26

' mit der oCompDef.ClientGraphicsCollection
' -> tut nicht wie gewünscht! 
' 		(Text aus Teil wird auch in Bgr. angezeigt)
' mit der oDoc.NonTransactingClientGraphicsCollection 
' => scheint es zu klappen! 

'(die "On Error" Anweisungen stammen aus VBA sollten hier besser auf Try umgestellt werden)

Class thisRule 
	
Private Const sGraphCollName As String = "Anchored Text"

Sub Main()
	
	AnchoredClientGraphics()
	
	MsgBox ("Fertig")  'nur Testweise, um zu merken, dass die Regel gelaufen ist
End Sub

Private Sub AnchoredClientGraphics()
  ' Set a reference to the document.
  Dim oDoc As Document = ThisApplication.ActiveDocument

  ' Set a reference to the component definition.
  ' This assumes that the active document is a part or an assembly.
  Dim oCompDef As ComponentDefinition = oDoc.ComponentDefinition

  ' Attempt to get the existing client graphics object. If it exists
  ' delete it so the rest of the code can continue as if it never existed.
  Dim oClientGraphics As ClientGraphics
  On Error Resume Next
  oClientGraphics = oDoc.NonTransactingClientGraphicsCollection.Item(sGraphCollName)	'.NonTransacting... !
  	'vorher oCompDef.ClientGraphicsCollection.
  If Err.Number = 0 Then
    oClientGraphics.Delete
  End If
  On Error GoTo 0
  ThisApplication.ActiveView.Update

  ' Create a new ClientGraphics object.
'  oClientGraphics = oCompDef.ClientGraphicsCollection.Add(sGraphCollName)
  oClientGraphics = oDoc.NonTransactingClientGraphicsCollection.Add(sGraphCollName)		'.NonTransacting... !

  ' Create a graphics node.
  Dim oNode As GraphicsNode = oClientGraphics.AddNode(1)

  ' Create text graphics.
  Dim oTextGraphics As TextGraphics = oNode.AddTextGraphics

  'Text aus iProperty lesen
  Dim sTxt As String
  sTxt = ReadiProp_Description(oDoc, True)

  ' Set the properties of the text.
  oTextGraphics.Text = sTxt
  oTextGraphics.Bold = True
  oTextGraphics.FontSize = 30
  Call oTextGraphics.PutTextColor(0, 255, 0)

  Dim oAnchorPoint As Point
  oAnchorPoint = ThisApplication.TransientGeometry.CreatePoint(1, 1, 1)

  ' Set the text's anchor in model space.
  oTextGraphics.Anchor = oAnchorPoint

  ' Anchor the text graphics in the view.
  Call oTextGraphics.SetViewSpaceAnchor( _
      oAnchorPoint, ThisApplication.TransientGeometry.CreatePoint2d(30, 30), _
      kTopLeftViewCorner)

  ' Update the view to see the text.
  ThisApplication.ActiveView.Update
End Sub

Private Function ReadiProp_Description(ByRef doc As Document, Optional bSilent As Boolean = False) As String
'Wert lesen aus iProp "Description" 
'aus dem PropertySet "Design Tracking Properties"
' 	bSilent : False	: Meldung, falls iProp nicht existiert
    
	'Name des iProp (sollte auf der dt. Oberfl. Bezeichnung heissen)
    Dim PropertyName As String = "Description"
    
    'Default-Rückgabewert (wenn Prop nicht existiert)
    ReadiProp_Description = "" 
    
    'raus, wenn doc nicht gesetzt ist
    If doc Is Nothing Then Exit Function
        'Rueckgabe mit Defaultwert
    
    ' Get the property set.
    Dim oPropSet As PropertySet
    oPropSet = doc.PropertySets.Item("{32853F0F-3444-11D1-9E93-0060B03C1CA6}")  'internalName "Design Tracking Properties"

    ' Get the existing property, if it exists.
    Dim prop As Inventor.Property
    On Error Resume Next
    prop = oPropSet.Item(PropertyName)

    ' Check to see if the above call failed.  If it failed
    ' then the property doesn't exist.
    If Err.Number <> 0 Then
    ' Failed to get the existing property
        If False = bSilent Then ' keine Meldung bei bSilent
            MsgBox ("iProperty existiert nicht!" & vbCrLf & PropertyName, vbCritical, "Fkt. ReadiProp_Description")
        End If
    Else
        'Prop existiert, Wert lesen
        ReadiProp_Description = prop.value
    End If
    
End Function

End Class