拖動選中元素居中顯示

拖動選中元素實現居中顯示...只要是實現了IExtension接口，當鼠標選定目標后觸發事件.

Option Explicit
 Implements IExtension

 Private WithEvents p As GraphicsContainerEvents
 Dim m_pApp As IApplication

 Dim WithEvents m_pDoc As MxDocument
 


 Private Property Get()Property Get IExtension_Name() As String
     IExtension_Name = "Moving Center"
 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
     ' Do something when a new document is created
    InitalElementUpdateEvent
 End Function
 
 Private Function m_pDoc_OpenDocument()Function m_pDoc_OpenDocument() As Boolean
     ' So something when a document is opened.
   InitalElementUpdateEvent
 
 End Function

Private Sub InitalElementUpdateEvent()Sub InitalElementUpdateEvent()
    Dim pMxd As IMxDocument
    Set pMxd = getmxd
    
    Dim pBM As IBasicMap
    Set pBM = pMxd.FocusMap
    Set p = pBM.BasicGraphicsLayer

End Sub

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

Private Sub p_ElementUpdated()Sub p_ElementUpdated(ByVal Element As esriCarto.IElement)
    
    If TypeOf getmxd.activeView Is IPageLayout Then
        MsgBox "Please switch to data view."
        Exit Sub
    End If
    
    Dim pMap As IMap
    Set pMap = getmxd.activeView
    Dim pMapGraphicsSelect As IGraphicsContainerSelect
    Set pMapGraphicsSelect = pMap
    
    
    Dim pEnumElement As IEnumElement
    Set pEnumElement = pMapGraphicsSelect.SelectedElements
    pEnumElement.Reset
    
    Dim pElement As IElement
    Dim pEleProperty As IElementProperties
    Set pElement = pEnumElement.Next
    
    Do While Not pElement Is Nothing
        Set pEleProperty = pElement
        If pEleProperty.Name = "ppextent" Then
           
           Dim pPoint As IPoint
           Set pPoint = New Point
           
           pPoint.x = 0.5 * (pElement.Geometry.envelope.LowerLeft.x + pElement.Geometry.envelope.UpperRight.x)
           pPoint.y = 0.5 * (pElement.Geometry.envelope.LowerLeft.y + pElement.Geometry.envelope.UpperRight.y)
           
           Set pPoint.SpatialReference = pElement.Geometry.envelope.SpatialReference
              
           
           Dim activeView As IActiveView
           Set activeView = getmxd.activeView
           
           Dim envelope As IEnvelope
           Set envelope = activeView.Extent
           envelope.CenterAt pPoint
           
           activeView.Extent = envelope
           
           getmxd.activeView.Refresh
           Exit Sub
        End If
        
         Set pElement = pEnumElement.Next
    Loop

   
End Sub