AO实现自动更新字段

AO Extension to udpate attribute field when editing attribute table. 实现当用户在属性表更新数据时，某个字段也被自动更新.

 Option Explicit
 Implements IExtension

 Private WithEvents m_pEditEvents As esriEditor.Editor
 Dim m_pApp As IApplication

 Dim WithEvents m_pDoc As MxDocument
 
 Private Property Get()Property Get IExtension_Name() As String
     IExtension_Name = "Update label"
 End Property
 
 Private Sub IExtension_Shutdown()Sub IExtension_Shutdown()
     ' Clear the reference to the Application and MxDocument
     Set m_pApp = Nothing
     Set m_pDoc = Nothing
 End Sub
 
 Private Sub IExtension_Startup()Sub IExtension_Startup(initializationData As Variant)

     Set m_pApp = initializationData
     'Start listening for the MxDocument events.
     Set m_pDoc = m_pApp.Document

 End Sub 


 Private Function m_pDoc_NewDocument()Function m_pDoc_NewDocument() As Boolean
 
 Set m_pEditEvents = m_pApp.FindExtensionByName("esriEditor.Editor")
 
 End Function


 Private Function m_pDoc_OpenDocument()Function m_pDoc_OpenDocument() As Boolean
 
   Set m_pEditEvents = m_pApp.FindExtensionByName("esriEditor.Editor")
 
 End Function

 Private Function getmxd()Function getmxd() As IMxDocument
    Set getmxd = m_pDoc
 End Function



Private Sub m_pEditEvents_OnChangeFeature()Sub m_pEditEvents_OnChangeFeature(ByVal obj As esriGeoDatabase.IObject)

    If TypeOf obj Is IFeature Then
        Dim pf As IFeature
        Set pf = obj
     
        If verifyFile(LCase(pf.Class.AliasName), "m_subdivision_shape") = True Then
            Dim pSubDivNO As String
            pSubDivNO = Trim(pf.Value(pf.Fields.FindField("SUB_DIV_NO")))
            
            Dim pMR  As String
            pMR = Trim(pf.Value(pf.Fields.FindField("MR")))
            
            Dim pRespPTY As String
            pRespPTY = Trim(pf.Value(pf.Fields.FindField("RESP_PTY")))
            
            If pSubDivNO <> "" And pMR <> "" And pRespPTY <> "" Then
                pf.Value(pf.Fields.FindField("LABEL")) = "Sub(" + CStr(pf.Value(pf.Fields.FindField("SUB_DIV_NO"))) + ")_" + CStr(pf.Value(pf.Fields.FindField("RESP_PTY"))) + "_(" + CStr(pf.Value(pf.Fields.FindField("MR"))) + ")"
           
            End If
        End If
     
    End If

End Sub



Private Function verifyFile()Function verifyFile(subjectString As String, Pattern As String) As Boolean

Dim myRegExp As RegExp
Set myRegExp = New RegExp

myRegExp.IgnoreCase = True
myRegExp.Global = True
myRegExp.Pattern = Pattern

verifyFile = myRegExp.Test(subjectString)

End Function