IExtension應用實例

ARCMAP扩展, 實現移動特定element，視圖中心將隨element改變。

做好這個dll后,调用 windows 目录下 system32 子目录下的 regsvr32.exe 用下面的形式
注册编译好的DLL: win 目录\system32\regsvr32.exe  <路径>\<文件名>.dll . 运行
<arcmap 目录>\arcexe81\Bin\categories.exe,在打开的 Component
Catregory Manager 中找到 ESRI Mx Extensions,点击 Add Object…按钮将上面
注册的DLL 文件加入，并选中实现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

 

转载于:https://www.cnblogs.com/iswszheng/archive/2009/04/03/1429053.html