Get Connected Change Action Name From Physical Product

Hello,

I want to add the Change action number connected to a part or product to a field in the technical drawing macro. I can access the VPMReference object from the view in the technical drawing and print all the data belonging to the VPMReference object. For example, the Custom attribute of VPMReference. My CATLinks code sequence from which I pulled these features is as follows. Actually, I want the relationship seen in the picture to be visible in the technical drawing.

 

 

Sub CATLinks()
 '-------------------------------------------------------------------------------
 'How to fill in texts with data of the part/product linked with current sheet
 '-------------------------------------------------------------------------------
 On Error Resume Next
 Dim VPMRef As VPMReference
 Dim unixTime, normalTime
 If GetContext()="DRW" Then
   If Views.Count>=3 Then 
     Dim CurGenView as DrawingGenView
     Set CurGenView = Views.Item(3).DrawingGenView 
     Set VPMRef = CurGenView.GetAssociatedRootProduct
   End If
 End If 
 If (GetRootReference = empty) Then
   If (TypeName(CATIA) = "CATIAApplicationCoClass") Then
     Dim productService As PLMProductService
     Set productService = CATIA.ActiveEditor.GetService("PLMProductService")
     Dim rootOccObject As VPMRootOccurrence
     Set rootOccObject = productService.RootOccurrence
     If (Not IsEmpty(rootOccObject)) Then
       Dim rootReference As VPMReference
       Set VPMRef = rootOccObject.ReferenceRootOccurrenceOf
     End If
   Else
     Set VPMRef = CATIA
   End If
 End If
 
 If (Not IsEmpty(VPMRef)) Then
   Texts.GetItem("TitleBlock_Text_Weight_V").Text             = FormatNumber(VPMRef.GetAttributeValue("V_WCG_Mass"), 3)
    Texts.GetItem("TitleBlock_Text_CustomAtr").Text     = VPMRef.GetAttributeValue("CustomAtr")
    End If
   ' Gets the drawing Editor 
  Dim drwEditor As Editor 
  Set drwEditor = CATIA.ActiveEditor

  ' Gets the drawing Root 
  Dim drwRoot As DrawingRoot 
  Set drwRoot = drwEditor.ActiveObject

  ' Gets the drawing owner
  Dim drwRepRef As VPMRepReference 
  Set drwRepRef = drwRoot.Parent 
    Texts.GetItem("TitleBlock_Text_Def").Text     = drwRepRef.GetAttributeValue("owner") 
 

 '-------------------------------------------------------------------------------
 'Display sheet scale
 '-------------------------------------------------------------------------------
 Dim textScale As DrawingText
 Set textScale = Texts.GetItem("TitleBlock_Text_Scale_1")
 textScale.Text = ""
 Select Case GetContext():
   Case "LAY": textScale.InsertVariable 0, 0, CATIA.ActiveEditor.ActiveObject.Parameters.Item(CATIA.ActiveEditor.ActiveObject.Name+"\"+Sheet.Name+"\Scale")
   Case "DRW": textScale.InsertVariable 0, 0, CATIA.ActiveEditor.ActiveObject.Parameters.Item("Drawing\"+Sheet.Name+"\Scale")
   'Case "LAY": textScale.InsertVariable 0, 0, CATIA.ActiveEditor.ActiveObject.Parameters.Item(CATIA.ActiveEditor.ActiveObject.Name+"\"+Sheet.Name+"\ViewMakeUp2DL.1\Scale")
   'Case "DRW": textScale.InsertVariable 0, 0, CATIA.ActiveEditor.ActiveObject.Parameters.Item("Drawing\"+Sheet.Name+"\ViewMakeUp.1\Scale")
   Case Else:Text.Text = "XX"
 End Select
 
 '-------------------------------------------------------------------------------
 'Display sheet format
 '-------------------------------------------------------------------------------
 Dim textFormat As DrawingText
 Set textFormat = Texts.GetItem("TitleBlock_Text_Size_1")
 textFormat.Text = GetDisplayFormat()


 '-------------------------------------------------------------------------------
 'Display sheet numbering
 '-------------------------------------------------------------------------------
 Dim nbSheet  As Integer
 Dim curSheet As Integer
 If Not DrwSheet.IsDetail Then
   For Each itSheet In Sheets
     If Not itSheet.IsDetail Then nbSheet = nbSheet + 1
   Next
   For Each itSheet In Sheets
     If Not itSheet.IsDetail Then
       curSheet = curSheet + 1        
       itSheet.Views.Item(2).Texts.GetItem("TitleBlock_Text_Sheet_1").Text = CStr(curSheet) & "/" & CStr(nbSheet)
     End If
   Next
 End If    
 On Error Goto 0
End Sub