Topic
  • 6 replies
  • Latest Post - ‏2014-12-05T14:28:19Z by MarkGregory
TJKing
TJKing
16 Posts

Pinned topic KeyGUID Removal

‏2014-03-27T18:13:13Z |

Recently, when System Architect 11.4.2.6 was released, IBM removed the "DoDAF2 GUIDs" (see release notes here).  This appears to mean the "KeyGUID" field which magically appeared in DM2 definitions a few releases ago. 

I'm happy to see them go because they caused no end of misery when trying to update definitions using CSV imports.  However, my encyclopedia has hundreds of definitions that have the KeyGUIDs embedded in relationships. If I make any single change to the definition (even just the description), any relationships also get updated to no longer have the KeyGUID of the other definition. Which is great! Except I'm trying to find a more efficient way to remove them all, without opening every definition and making one tiny manual change and saving it.  I tried a "verify and repair", but it deleted the relationships and corrupted the data so I now get a database error when I tried to export the definitions to make sure the data was fixed!

Long story short: does anyone have a proven method for updating all your pre-11.4.2.6 DM2 definitions to strip out the KeyGUIDs in relationships, following the upgrade to 11.4.2.6 (or later)?

Thanks in advance!
TJ

  • MarkFrazier
    MarkFrazier
    2 Posts
    ACCEPTED ANSWER

    Re: KeyGUID Removal

    ‏2014-08-04T14:09:39Z  
    • sammyc
    • ‏2014-08-04T12:39:14Z

    Mark - your email bounced for me. Can you post the macro here on the forum?

    Thanks - Sam

    Here's the macro IBM wrote:

    Private Sub Cleanup()

        'Call RemoveKeyGuids for each definition type you want to process

        RemoveKeyGuids 1326 'Activity (DM2)

    End Sub

     

    Private Sub RemoveKeyGuids(ByVal lDefType As Long)

     

        Dim oDef As Definition

        Dim oDefs As SAObjects

        Dim ISA As ISAImf

        Dim x As Long

        Dim oDisplay As SADisplay

        Dim strOrigName As String

        Dim strTempName As String

       

        Application.Encyclopedia.OpenObjectsAsReadOnly = True

        Set ISA = Application.Interface("ISAImf")

        Set oDisplay = New SADisplay

        oDisplay.StartLog "RemoveKeyGuids for type " & CStr(lDefType), "Arial",

    0, 8, 0

        oDisplay.LogText "RemoveKeyGuids for type " & CStr(lDefType) & "

    started" + vbCrLf

       

        Set oDefs = Application.Encyclopedia.GetFilteredDefinitions("",

    lDefType)

        oDefs.ReadAll

       

        For Each oDef In oDefs

            strOrigName = Chr(34) + oDef.Name + Chr(34)

            strTempName = Chr(34) + oDef.Name + "_1" + Chr(34)

            'Rename the definition to a temp name

            x = ISA.SARemoteRenameDefinition(oDef.ddId, strTempName)

            If x <> 0 Then

                oDisplay.LogText "Rename " + oDef.Name + " to " + strTempName +

    " failed" + vbCrLf

            End If

            'Rename the definition back to the original name

            x = ISA.SARemoteRenameDefinition(oDef.ddId, strOrigName)

            If x <> 0 Then

                oDisplay.LogText "Rename " + oDef.Name + " to " + strOrigName +

    " failed" + vbCrLf

            End If

        Next

       

        oDisplay.LogText "RemoveKeyGuids for type " & CStr(lDefType) & "

    completed" + vbCrLf

        oDisplay.StopLog 1

     

    End Sub

     

     

  • MarkFrazier
    MarkFrazier
    2 Posts

    Re: KeyGUID Removal

    ‏2014-08-01T16:44:51Z  

    IBM developed a macro that removes the keyguid from existing definitions that have keyguids.  E-mail me at mark.frazier2@wpafb.af.mil and I'll send it to you.  You run it for each definition type where you want to remove them.

     

    Mark

    Updated on 2014-08-01T16:45:23Z at 2014-08-01T16:45:23Z by MarkFrazier
  • sammyc
    sammyc
    108 Posts

    Re: KeyGUID Removal

    ‏2014-08-04T12:39:14Z  

    IBM developed a macro that removes the keyguid from existing definitions that have keyguids.  E-mail me at mark.frazier2@wpafb.af.mil and I'll send it to you.  You run it for each definition type where you want to remove them.

     

    Mark

    Mark - your email bounced for me. Can you post the macro here on the forum?

    Thanks - Sam

  • MarkFrazier
    MarkFrazier
    2 Posts

    Re: KeyGUID Removal

    ‏2014-08-04T14:09:39Z  
    • sammyc
    • ‏2014-08-04T12:39:14Z

    Mark - your email bounced for me. Can you post the macro here on the forum?

    Thanks - Sam

    Here's the macro IBM wrote:

    Private Sub Cleanup()

        'Call RemoveKeyGuids for each definition type you want to process

        RemoveKeyGuids 1326 'Activity (DM2)

    End Sub

     

    Private Sub RemoveKeyGuids(ByVal lDefType As Long)

     

        Dim oDef As Definition

        Dim oDefs As SAObjects

        Dim ISA As ISAImf

        Dim x As Long

        Dim oDisplay As SADisplay

        Dim strOrigName As String

        Dim strTempName As String

       

        Application.Encyclopedia.OpenObjectsAsReadOnly = True

        Set ISA = Application.Interface("ISAImf")

        Set oDisplay = New SADisplay

        oDisplay.StartLog "RemoveKeyGuids for type " & CStr(lDefType), "Arial",

    0, 8, 0

        oDisplay.LogText "RemoveKeyGuids for type " & CStr(lDefType) & "

    started" + vbCrLf

       

        Set oDefs = Application.Encyclopedia.GetFilteredDefinitions("",

    lDefType)

        oDefs.ReadAll

       

        For Each oDef In oDefs

            strOrigName = Chr(34) + oDef.Name + Chr(34)

            strTempName = Chr(34) + oDef.Name + "_1" + Chr(34)

            'Rename the definition to a temp name

            x = ISA.SARemoteRenameDefinition(oDef.ddId, strTempName)

            If x <> 0 Then

                oDisplay.LogText "Rename " + oDef.Name + " to " + strTempName +

    " failed" + vbCrLf

            End If

            'Rename the definition back to the original name

            x = ISA.SARemoteRenameDefinition(oDef.ddId, strOrigName)

            If x <> 0 Then

                oDisplay.LogText "Rename " + oDef.Name + " to " + strOrigName +

    " failed" + vbCrLf

            End If

        Next

       

        oDisplay.LogText "RemoveKeyGuids for type " & CStr(lDefType) & "

    completed" + vbCrLf

        oDisplay.StopLog 1

     

    End Sub

     

     

  • sammyc
    sammyc
    108 Posts

    Re: KeyGUID Removal

    ‏2014-08-04T22:48:30Z  

    IBM developed a macro that removes the keyguid from existing definitions that have keyguids.  E-mail me at mark.frazier2@wpafb.af.mil and I'll send it to you.  You run it for each definition type where you want to remove them.

     

    Mark

    Thank you!

    Sam

  • TJKing
    TJKing
    16 Posts

    Re: KeyGUID Removal

    ‏2014-09-10T12:38:43Z  

    Here's the macro IBM wrote:

    Private Sub Cleanup()

        'Call RemoveKeyGuids for each definition type you want to process

        RemoveKeyGuids 1326 'Activity (DM2)

    End Sub

     

    Private Sub RemoveKeyGuids(ByVal lDefType As Long)

     

        Dim oDef As Definition

        Dim oDefs As SAObjects

        Dim ISA As ISAImf

        Dim x As Long

        Dim oDisplay As SADisplay

        Dim strOrigName As String

        Dim strTempName As String

       

        Application.Encyclopedia.OpenObjectsAsReadOnly = True

        Set ISA = Application.Interface("ISAImf")

        Set oDisplay = New SADisplay

        oDisplay.StartLog "RemoveKeyGuids for type " & CStr(lDefType), "Arial",

    0, 8, 0

        oDisplay.LogText "RemoveKeyGuids for type " & CStr(lDefType) & "

    started" + vbCrLf

       

        Set oDefs = Application.Encyclopedia.GetFilteredDefinitions("",

    lDefType)

        oDefs.ReadAll

       

        For Each oDef In oDefs

            strOrigName = Chr(34) + oDef.Name + Chr(34)

            strTempName = Chr(34) + oDef.Name + "_1" + Chr(34)

            'Rename the definition to a temp name

            x = ISA.SARemoteRenameDefinition(oDef.ddId, strTempName)

            If x <> 0 Then

                oDisplay.LogText "Rename " + oDef.Name + " to " + strTempName +

    " failed" + vbCrLf

            End If

            'Rename the definition back to the original name

            x = ISA.SARemoteRenameDefinition(oDef.ddId, strOrigName)

            If x <> 0 Then

                oDisplay.LogText "Rename " + oDef.Name + " to " + strOrigName +

    " failed" + vbCrLf

            End If

        Next

       

        oDisplay.LogText "RemoveKeyGuids for type " & CStr(lDefType) & "

    completed" + vbCrLf

        oDisplay.StopLog 1

     

    End Sub

     

     

    Thank you, Mark!  I appreciate your help with this!

    TJ

  • MarkGregory
    MarkGregory
    9 Posts

    Re: KeyGUID Removal

    ‏2014-12-05T14:28:19Z  

    Adding the macros present in 11.4.3.2...

    Definition_WarnOfItemsWithDuplicateNames
    Definition_MakeItemNamesUnique
    Definition_CorrectDefinitionsWhenKeysHaveBeenRemoved

    If you have removed GUID keys from definition types then you should use the first or second macro to make sure all names are unique, and then run the third macro. These give progress feedback via the status bar. The third macro ought to be faster then the approach previously posted as it is only correcting the references once.

     

    ' re removal of GUID key from DoDAF 2 definitions
    ' warn for all types except for ones that are keyed

    Public Sub Definition_WarnOfItemsWithDuplicateNames()

        Dim imf As SA2001.ISAImf
        Dim strName As String
        Dim mcDefs As MetaClass
        Dim mi As MetaItem
        Dim oDisp As New SADisplay
        Dim oBaseDict As Object
        Dim oDuplicates As Object
        Dim ddidp As Long
        Dim ddid As Long
        Dim hdef As Long
        Dim lGridRow As Long
        Dim strRowData As String
        Dim oDuplicate As Variant
        Dim lngTypeMax As Long
        Dim lngTypeCnt As Long
        
        On Error GoTo ErrorHandler
            
        'Setup the grid report
        oDisp.StartGrid "Duplicate Unkeyed Definition Names", "", 1, 1, 1, "", "", 0, 1, True
        oDisp.SetGridContext 1 'USE_SEARCH
        oDisp.SetGridTextAt 0, 0, "Type"
        oDisp.SetGridTextAt 0, 1, "Name"
        lGridRow = 1
            
        Set imf = SA2001.Interface("isaimf")
        Set mcDefs = SA2001.Encyclopedia.MetaModel.MetaClasses.Item(3)
        lngTypeMax = mcDefs.SupportedMetaItems.Count
        For Each mi In mcDefs.SupportedMetaItems()
            lngTypeCnt = lngTypeCnt + 1
            
            SA2001.WriteStatusLine "Processing type " + Format(lngTypeCnt) + " of " + Format(lngTypeMax)
            
            If IsMetaItemKeyed(mi) = False Then 'Only process types that have no keys
                Set oBaseDict = CreateObject("Scripting.Dictionary") 'Used to keep track of all names for the current type
                Set oDuplicates = CreateObject("Scripting.Dictionary") 'Used to keep track of all duplicate name instances for the current type
                ddidp = 0
                While 0 = imf.SAFindDefinition(ddidp, "", mi.TypeNumber, ddid)
                    If 0 = imf.SAOpenLockDefinition(0, ddid, hdef) Then
                        Call imf.SAGetDefinitionName(hdef, strName, 100)
                        If oBaseDict.Exists(strName) = False Then
                            'The name doesn't exist in the base collection so add it
                            oBaseDict.Add strName, ddid
                        Else
                            'The name already exists in the base collection so that means we found a duplicate
                            'We want to make sure that all duplicate name instances are added to the duplicate collection
                            'First add the current name to the duplicate collection
                            oDuplicates.Add ddid, strName + "###" + Format(ddid) 'We'll need the ddid of this object later so append it to the name using ### format
                            'Next we want to make sure the duplicate name already in the base collection is also added to the duplicate collection
                            If oDuplicates.Exists(oBaseDict.Item(strName)) = False Then
                                oDuplicates.Add oBaseDict.Item(strName), strName + "###" + Format(oBaseDict.Item(strName))
                            End If
                        End If
                        imf.SACloseDefinition hdef
                    End If
                    ddidp = ddid
                Wend
                
                'We have the complete list of duplicates for this definition type so now process them and populate the grid report
                'We need to pull the name and ddid apart so we can setup the grid data (id, class, type)
                'The grid data allows a user to click the row in the grid and have the properties and references window show the details of that object
                For Each oDuplicate In oDuplicates.Items
                    oDisp.SetGridTextAt lGridRow, 0, mi.TypeName
                    oDisp.SetGridTextAt lGridRow, 1, GetNameOrId(oDuplicate, True)
                    strRowData = GetNameOrId(oDuplicate, False) + ",3," + Format(mi.TypeNumber)
                    oDisp.SetGridDataAt lGridRow, 0, strRowData
                    oDisp.SetGridDataAt lGridRow, 1, strRowData
                    lGridRow = lGridRow + 1
                Next
                
            End If
        Next

        Exit Sub
        
    ErrorHandler:
        Resume Next
        
    End Sub

    Private Function GetNameOrId(ByVal strIn As String, ByVal bName As Boolean) As String

        'Returns the object name or ddid which are seperated by ###

        Dim strOut() As String
        
        On Error GoTo ErrorHandler
        
        strOut = Split(strIn, "###")
        
        If bName = True Then
            GetNameOrId = strOut(0)
        Else
            GetNameOrId = strOut(1)
        End If

        Exit Function

    ErrorHandler:
        GetNameOrId = "Error: " + Err.Description
        
    End Function

    Private Function IsMetaItemKeyed(ByVal oMetaItem As MetaItem) As Boolean

        'Returns true if the meta item has at least one key property

        On Error GoTo ErrorHandler
        
        Dim oProperty As MetaProperty
        
        For Each oProperty In oMetaItem.MetaProperties
            If oProperty.Key = True Then
                IsMetaItemKeyed = True
                Exit For
            End If
        Next

        Exit Function

    ErrorHandler:
        IsMetaItemKeyed = False
        
    End Function

    ' Try to automatically make item names unique
    ' Report failures to user
    Public Sub Definition_MakeItemNamesUnique()
        Dim imf As SA2001.ISAImf
        Dim strName As String
        Dim mcDefs As MetaClass
        Dim mi As MetaItem
        Dim oBaseDict As Object
        Dim ddidp As Long
        Dim ddid As Long
        Dim hdef As Long
        Dim oDisp As New SADisplay
        Dim lGridRow As Long
        Dim strRowData As String
        Dim oDuplicateCol As Variant
        Dim oDuplicate As Variant
        Dim colDupsByName As Collection
        Dim col As Collection
        Dim lngRenCnt As Long
        Dim lngCnt As Long
        Dim lngRet As Long
        Dim lngTypeMax As Long
        Dim lngTypeCnt As Long
        Dim strTypeMsg As String
        Dim lngDupCnt As Long
        Dim lngDupMax As Long
        Dim strDupMsg As String
        Dim str As String
        
        On Error GoTo ErrorHandler
            
        'Setup the grid report
        oDisp.StartGrid "Duplicates Which Must be Renamed Manually", "", 1, 1, 1, "", "", 0, 1, True
        oDisp.SetGridContext 1 'USE_SEARCH
        oDisp.SetGridTextAt 0, 0, "Type"
        oDisp.SetGridTextAt 0, 1, "Name"
        lGridRow = 1
            
        Set imf = SA2001.Interface("isaimf")
        Set mcDefs = SA2001.Encyclopedia.MetaModel.MetaClasses.Item(3)
        lngTypeMax = mcDefs.SupportedMetaItems.Count
        For Each mi In mcDefs.SupportedMetaItems()
            lngTypeCnt = lngTypeCnt + 1
            
            strTypeMsg = "Processing type " + Format(lngTypeCnt) + " of " + Format(lngTypeMax)
            SA2001.WriteStatusLine strTypeMsg
            
            If IsMetaItemKeyed(mi) = False Then 'Only process types that have no keys
                Set oBaseDict = CreateObject("Scripting.Dictionary") 'Used to keep track of all names for the current type
                Set colDupsByName = New Collection
                ddidp = 0
                While 0 = imf.SAFindDefinition(ddidp, "", mi.TypeNumber, ddid)
                    If 0 = imf.SAOpenLockDefinition(0, ddid, hdef) Then
                        Call imf.SAGetDefinitionName(hdef, strName, 100)
                        If oBaseDict.Exists(strName) = False Then
                            'The name doesn't exist in the base collection so add it
                            oBaseDict.Add strName, ddid
                        Else
                            'The name already exists in the base collection so that means we found a duplicate
                            'We want to make sure that all duplicate name instances are added to the duplicate collection
                            'Add the current name to the duplicate collection
                            On Error Resume Next
                            Set col = Nothing
                            Set col = colDupsByName.Item(strName)
                            On Error GoTo 0
                            If col Is Nothing Then
                                ' new
                                Set col = New Collection
                                col.Add strName
                                col.Add ddid
                                colDupsByName.Add col, strName
                            Else
                                col.Add ddid
                                colDupsByName.Remove strName
                                colDupsByName.Add col, strName
                            End If
                        End If
                        imf.SACloseDefinition hdef
                    End If
                    ddidp = ddid
                Wend
                
                'We have the complete list of duplicates (that need to be renamed) for this definition type so now process them
                For Each oDuplicateCol In colDupsByName
                    Set col = oDuplicateCol
                    strName = col.Item(1)
                    lngRenCnt = 2
                    lngDupCnt = 1
                    lngDupMax = col.Count - 1
                    For lngCnt = 2 To col.Count
                        strDupMsg = " Processing duplicate " + Format(lngDupCnt) + " of " + Format(lngDupMax)
                        SA2001.WriteStatusLine strTypeMsg + strDupMsg
                        
                        oDuplicate = col.Item(lngCnt)
                        lngRet = 1
                        ddidp = 0
                        While 0 = imf.SAFindDefinition(ddidp, strName & lngRenCnt, mi.TypeNumber, ddid)
                            lngRenCnt = lngRenCnt + 1
                        Wend
                        ddid = oDuplicate
                        lngRet = imf.SAOpenLockDefinitionReturn(1, ddid, hdef, str, 255)
                        If 0 = lngRet Then
                            imf.SACloseDefinition hdef
                            lngRet = imf.SARemoteRenameDefinition(oDuplicate, strName & lngRenCnt)
                        End If
                        If lngRet <> 0 Or Len(str) > 0 Then
                            oDisp.SetGridTextAt lGridRow, 0, mi.TypeName
                            oDisp.SetGridTextAt lGridRow, 1, strName
                            strRowData = Format(oDuplicate) + ",3," + Format(mi.TypeNumber)
                            oDisp.SetGridDataAt lGridRow, 0, strRowData
                            oDisp.SetGridDataAt lGridRow, 1, strRowData
                            lGridRow = lGridRow + 1
                        End If
                        lngDupCnt = lngDupCnt + 1
                    Next
                Next
                
            End If
        Next

        Exit Sub
        
    ErrorHandler:
        Resume Next
        
    End Sub


    ' RE RepCon Hierarchy diagrams.. layout can change as a result of keyness having been changed since the definitions were last saved
    '..because the saved value based on old keyness is compared with a constructed value based on new keyness.
    'Solution: Must force re-saving of all definitions, at least on the diagram, ideally across ency.

    ' The following works, just walk through reference-type properties, obtain the property as a collection and then save it.
    ' Dict Update, V&R didn't do it. Only opening, changing value and saving appears to work, in SA UI.

    Sub Definition_CorrectDefinitionsWhenKeysHaveBeenRemoved()
        Dim saoDefs As SAObjects
        Dim blnRO As Boolean
        Dim oDef As Definition
        Dim str As String
        Dim lngCnt As Long
        Dim lngMax As Long
        Dim oc As OfCollection
        Dim mi As MetaItem
        Dim mc As MetaClass
        Dim mp As MetaProperty
        Dim bChg As Boolean
        
        If vbNo = MsgBox("Have you confirmed that you have not enabled GUID keys on definition types on an existing encyclopedia? If not some definitions may lose their references. Use Cleanup.Definition_WarnOfItemsWithDuplicateNames or Cleanup.Definition_MakeItemNamesUnique", vbYesNo) Then
            Exit Sub
        End If
        
        On Error GoTo exitpoint
        blnRO = SA2001.Encyclopedia.OpenObjectsAsReadOnly
        SA2001.Encyclopedia.OpenObjectsAsReadOnly = False
        Set mc = SA2001.Encyclopedia.MetaModel.MetaClasses(3)
        Set saoDefs = SA2001.Encyclopedia.GetAllDefinitions()
        saoDefs.ReadAll
        lngMax = saoDefs.Count
        For Each oDef In saoDefs
            bChg = False
            lngCnt = lngCnt + 1
            Set mi = mc.MetaItems(oDef.SAType)
            Debug.Print oDef.name
            On Error Resume Next
            For Each mp In mi.MetaProperties
                If Right(LCase(mp.EditType), 2) = "of" Then
                    Set oc = oDef.GetPropertyAsCollection(mp.name)
                    oc.SetProperty
                    bChg = True
                End If
            Next
            If bChg Then
                oDef.Save
            End If
            str = "(" & lngCnt & " of " & lngMax & ")"
            SA2001.WriteStatusLine str
            On Error GoTo exitpoint
        Next
        Set saoDefs = Nothing
        
    exitpoint:
        If Err.Number <> 0 Then
            MsgBox "Error " & Err.Number & ", " & Err.Description & ", " & Err.Source
        End If
        SA2001.Encyclopedia.OpenObjectsAsReadOnly = blnRO
    End Sub