用程序启动ArcMap工作文档的VB代码实现

昨天在图书馆，空间信息学院的一MM找到我帮忙，她需要在VB下启动ArcMap的代码。下午利用休息时间写了代码，其实在VB下启动ArcMap并不难，无非就是启动ArcMap的应用程序和ArcMap的工作文档，与VB调用Office WORD方法类似。具体代码如下,我已经调试通过.

Option Explicit

Private m_pDoc As IDocument

Private m_pApp As IApplication

Private WithEvents m_pAppRot As AppROT

Sub QuitArcMap()

  If m_pDoc Is Nothing Then

    Exit Sub

  Else

    m_pApp.Shutdown ' Quit ArcMap

    Set m_pDoc = Nothing ' Release m_pDoc

    Set m_pApp = Nothing ' Releasr m_pApp

    cmdStartArcMap.Enabled = True

    cmdAddData.Enabled = False

    cmdQuitArcMap.Enabled = False

  End If

End Sub

Sub StartArcMap()

  If m_pDoc Is Nothing Then

    frmStartArcMap.MousePointer = vbHourglass

    ' 打开ArcMap

    Set m_pDoc = New MxDocument

    ' 获得程序的引用

    Set m_pApp = m_pDoc.Parent

    ' 显示ArcMap

    m_pApp.Visible = True

    cmdStartArcMap.Enabled = False

    cmdAddData.Enabled = True

    cmdQuitArcMap.Enabled = True

    frmStartArcMap.MousePointer = vbNormal

  End If

End Sub

Private Sub cmdAddData_Click()

  Dim pObjFactory As IObjectFactory

  Dim pMxDoc As IMxDocument

  Dim pMap As IMap

  Dim pGxDialog As IGxDialog

  Dim pGxFilter As IGxObjectFilter

  Dim pGxObjects As IEnumGxObject

  Dim pGxDataset As IGxDataset

  Dim pFeatureLayer As IGeoFeatureLayer

  frmStartArcMap.MousePointer = vbHourglass

  '从程序中获得对象工厂接口

  Set pObjFactory = m_pApp

  ' 获得ArcMap文档和激活地图的引用

  Set pMxDoc = m_pDoc

  Set pMap = pMxDoc.FocusMap

  ' 创建特征层并添加到ArcMap

  ' 使用ArcMap一般对象工厂保证这些对象出现在ArcMap程序空间中

  ' 显示 GXDialog 允许用户选择数据

  Set pGxDialog = pObjFactory.Create("esriCatalogUI.GxDialog")

  pGxDialog.AllowMultiSelect = True

  pGxDialog.Title = "Select Feature Classes to Add To ArcMap"

  ' 设置 pGxFilter = New GxFilterFeatureClasses

  Set pGxFilter = pObjFactory.Create("esriCatalog.GxFilterFeatureClasses")

  Set pGxDialog.ObjectFilter = pGxFilter

  pGxDialog.DoModalOpen m_pApp.hWnd, pGxObjects

  If (pGxObjects Is Nothing) Then Exit Sub

  pGxObjects.Reset

  Set pGxDataset = pGxObjects.Next

  '创建图层

  Do While (Not pGxDataset Is Nothing)

    ' 设置 pFeatureLayer = New FeatureLayer

    Set pFeatureLayer = pObjFactory.Create("esriCarto.FeatureLayer")

    Set pFeatureLayer.FeatureClass = pGxDataset.Dataset

    pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName

    pMap.AddLayer pFeatureLayer

    Set pGxDataset = pGxObjects.Next

  Loop

  frmStartArcMap.MousePointer = vbNormal

End Sub

Private Sub cmdQuitArcMap_Click()

  QuitArcMap

End Sub

Private Sub cmdStartArcMap_Click()

  StartArcMap

End Sub

Private Sub Form_Load()

  Move 0, 0

  Set m_pAppRot = New AppROT

  cmdAddData.Enabled = False

  cmdQuitArcMap.Enabled = False

End Sub

Private Sub Form_Unload(Cancel As Integer)

  QuitArcMap

  Set m_pAppRot = Nothing

End Sub

Private Sub m_pAppRot_AppRemoved(ByVal pApp As esriFramework.IApplication)

  ' 如果退出ArcMap释放m_pDoc 和 m_pApp

  If TypeOf pApp Is IMxApplication Then

    If pApp.Document Is m_pDoc Then

      Set m_pDoc = Nothing

      Set m_pApp = Nothing

      cmdStartArcMap.Enabled = True

      cmdAddData.Enabled = False

      cmdQuitArcMap.Enabled = False

    End If

  End If

End Sub