You are here

Useful Scripts for the Non-Programmer: Where is My Field AU Configured?

Last month, I presented to you a script allowing you to find every configured location of a class-level autoupdater. Today, your mastery level over your ArcFM™ configuration will be increased once again.

This month’s VBA script is very similar to last month’s, except that it searches specifically for field autoupdaters. It will break down the configuration and let you know every combination of feature class, field, subtype, and event type that a specific autoupdater is configured for. This script has a distinct purpose compared to last month’s, but many aspects remain functionally the same. Enter the exact name of the field AU you want to find, and you’ll get a list of areas where the field AU is configured.

If you don’t know the display name of the field AU you want, you can grab the name from the ArcFM™ Properties Manager of a feature class that contains the field AU, and looking for the setting of a specific field under the "Field Info" tab.useful-scripts-get-field-display-name

This is another ArcCatalog script, so here’s a refresher on how to add it.

  • Open ArcCatalog
  • Drop down the Tools menu and choose Macros → Visual Basic Editor.
    useful-scripts-vb-editor.
  • Within the Visual Basic environment, expand the Normal.mxt file. Right-click it and insert a new Module within the Modules folder.
  • In the editor, click ToolsReferences and ensure that the following references are enabled:
    • Microsoft Scripting Runtime
    • Miner & Miner Geodatabase Object Library
    • Miner & Miner System Object Library

      useful-scripts-enable-references

The code for this module is below. Copy and paste it into the module and save it.


Dim m_returnValues() As String
Dim
searchAUName As String
Dim
ac As Integer

Public Sub
FindConfiguredFieldAUs()
    On Error GoTo EX

    ac = 0
    searchAUName = ""
    ReDim m_returnValues(0)

    Dim catalogApp As IGxApplication
    Set catalogApp = Application
    Dim ws As IWorkspace

    If TypeOf catalogApp.SelectedObject Is IGxDatabase Then
        Dim
gdb As IGxDatabase
        Set gdb = catalogApp.SelectedObject
        If gdb.IsConnected Then
            Set
ws = gdb.Workspace
        End If
    End If

    If
ws Is Nothing Then
        ShowError "Please select a database connection to search for when running this function."
        Exit Sub
    End If


    searchAUName = InputBox("Enter the AU Display Name to search for:", "Find Field Autoupdater by Name")

    If Not searchAUName = "" Then
        Dim
eDS As IEnumDataset
        Set eDS = ws.Datasets(esriDatasetType.esriDTAny)
        IterateDatasets eDS

        For l = 0 To UBound(m_returnValues)
            For
l2 = 1 To UBound (m_returnValues)
                If
UCase(m_returnValues(l2)) < UCase(m_returnValues(l)) Then
                    st1 = m_returnValues(l)
                    st2 = m_returnValues(l2)
                    m_returnValues(l) = st2
                    m_returnValues(l2) = st1
                End If
            Next
l2
        Next l

        Dim sb, i As Integer
        sb = "The '" & searchAUName & "' AU is configured in the following locations/subtypes:" & vbCrLf
        For i = 0 To UBound(m_returnValues)
            sb = sb & m_returnValues(i) & vbCrLf
        Next i

        Dim AUResultsFile As String
        AUResultsFile = "C:\Temp\FieldAUResults" & DatePart("yyyy", Now) & "-" & Right("0" & DatePart("m", Now), 2) & "-" & Right("0" & DatePart("d", Now), 2) & " " & Right("0" & DatePart("h", Now), 2) & Right("0" & DatePart("n", Now), 2) & ".txt"

        Dim fso As Scripting.FileSystemObject
        Set fso = New Scripting.FileSystemObject
        Dim writer As TextStream
        Set writer = fso.CreateTextFile(AUResultsFile, True)
        writer.Write sb
        Shell "notepad.exe " & AUResultsFile, vbMaximizedFocus
        writer.Close
        Debug.Print sb
        fso.DeleteFile AUResultsFile, True
    End If
    Exit Sub

EX: MsgBox "An error occured.", vbOKOnly, "SSP Find Configured Field AUs"
End Sub

Sub
IterateDatasets(pEnumDataset As IEnumDataset)
    Dim ds As IDataset

    pEnumDataset.Reset
    Set ds = pEnumDataset.Next
    Do While Not ds Is Nothing
        If
ds.Type = esriDatasetType.esriDTFeatureClass Then
            Dim
dfc As IFeatureClass
            Set dfc = ds
            ProcessFeatureClass dfc
        ElseIf ds.Type = esriDatasetType.esriDTFeatureDataset Then
            IterateDatasets ds.Subsets
        End If
        Set
ds = pEnumDataset.Next
    Loop
End Sub

Sub
ProcessFeatureClass(fc As IFeatureClass)
    If Not fc Is Nothing Then
        Dim
desc As String
        Dim
code As Long
        desc = ""

        Dim oc As IObjectClass
        Set oc = fc

        Dim enSt As IEnumSubtype
        Dim ocSt As ISubtypes

        Set ocSt = oc

        If Not ocST.HasSubtype Then Exit Sub

        Set
enSt = ocSt.Subtypes

        desc = enSt.Next(code)
        Do While Not desc = ""
            Dim ctl As IMMConfigTopLevel
            Set ctl = New MMConfigTopLevel

            Dim mmSubtype As IMMSubtype
            Dim list As ID8List
            Dim fList As ID8List
            Dim listItem As ID8ListItem
            Dim fListItem As ID8ListItem

            Set mmSubtype = ctl.GetSubtypeForEdit(oc, code)
            Set list = mmSubtype

            list.Reset
            Set listItem = list.Next(False)
            Do While Not listItem Is Nothing
                If
listItem.ItemType = mmd8ItemType.mmitField Then
                    Dim
field As IMMField
                    Set field = listItem

                    Set fList = listItem
                    fList.Reset
                    Set fListItem = fList.Next(False)
                    Do While Not fListItem Is Nothing
                        If fListItem.ItemType = mmd8ItemType.mmitAutoValue Then
                            Dim
autoValue As IMMAutoValue
                            Set autoValue = fListItem
                            If Not autoValue.autoGenID Is Nothing Then
                                Dim
UIDT As IMMUIDTools
                                Set UIDT = New MMUIDTools

                                Dim auGrab As Variant
                                Dim
auName As String

                                Dim
pAutoGenID As String
                                pAutoGenID = autoValue.autoGenID

                                Set auGrab = UIDT.CreateFromClsidString(pAutoGenID)
                                auName = ""

                                If TypeOf auGrab Is IMMAttrAUStrategy Then
                                    Dim
au As IMMAttrAUStrategy
                                    Set au = auGrab
                                    auName = au.Name
                                End If

                                If (Not
auName = "") And LCase(Trim(auName)) = LCase(Trim(searchAUName)) Then
                                    ReDim Preserve
m_returnValues(ac + 1)
                                    Dim sc As String
                                    sc = mmSubtype.SubtypeCode
                                    m_returnValues(ac) = oc.AliasName & " - " & field.FieldName & " (" & sc & ") " & fListItem.DisplayName
                                    ac = ac + 1
                                End If
                            End If
                        End If
                        Set
fListItem = fList.Next(False)
                    Loop
                End If
                Set
listItem = list.Next(False)
            Loop
            desc = enSt.Next(code)
        Loop
    End If
End Sub


 

Be sure that you have a connection open and selected in ArcCatalog, then run the script and enjoy the results!

useful-scripts-field-au-results

Author Information

  • Corey Blakeborough

    Corey Blakeborough

    Corey Blakeborough is a Senior Consultant at the Utility & Telecommunications GIS consulting company SSP Innovations in Centennial, Colorado. Corey has over five years of experience with SSP, providing a variety of GIS and work management solutions.

    See all items created by this author >

    Connect with me on:

Add new comment