【C006】ArcGIS VBA - IMap & ILayer

最新推荐文章于 2024-06-14 20:42:13 发布

weixin_34294649

最新推荐文章于 2024-06-14 20:42:13 发布

阅读量206

点赞数

IApplication接口：》》》点击查看《《《

移动选中图层，使用IMap接口的MoveLayer方法

Sub MapIndex()
    Dim pDoc As IMxDocument
    Dim pMap As IMap
    Dim pLayer As ILayer
    Set pDoc = ThisDocument
    Set pMap = pDoc.FocusMap
    Set pLayer = pDoc.SelectedLayer
    pMap.MoveLayer pLayer, pMap.LayerCount - 1
End Sub

IApplication接口的属性和方法

Sub Caption()
    Dim pApp As IApplication
    Set pApp = Application

    pApp.SaveDocument  '保存文件
    pApp.OpenDocument ("F:\MY_OWN_WORK\扫描图\2010年数字化\2010-矢量化.mxd")   '打开文件
    pApp.SaveAsDocument ("F:\Desktop\1.mxd")   '另存为文件
    pApp.Shutdown  '关闭应用程序
    pApp.NewDocument    '新建文件
    
    pApp.Visible = True    '可见
    pApp.Visible = False   '隐藏，不可见
End Sub

IWindowPosition接口的属性

Sub MoveWindow()
    Dim pWinPos As IWindowPosition
    Set pWinPos = Application
    pWinPos.Height = 300
    pWinPos.Width = 300
    pWinPos.Left = 50
    pWinPos.Top = 50
    pWinPos.State = esriWSMaximize
End Sub

IMxDocument接口的属性

Sub sdklfkj()
    Dim pApp As IApplication
    Dim pDoc As IMxDocument
    Dim pMap As IMap
    Dim pLayer As ILayer
    
    Set pApp = Application
    Set pDoc = pApp.Document
    Set pMap = pDoc.FocusMap        '当前地图（数据框架）
    
    Dim pMap2 As IMap
    Set pMap2 = pDoc.Maps.Item(1)   '第二个地图（第二个数据框架，从0开始）
End Sub

IDocumentDefaultSymbols

Sub changeTextSym()
    Dim pDoc As IDocument
    Set pDoc = ThisDocument
    
    Dim pDocSym As IDocumentDefaultSymbols
    Set pDocSym = pDoc
    
    Dim pRGB As IRgbColor
    Set pRGB = New RgbColor
    pRGB.Red = 110
    pRGB.Green = 0
    pRGB.Blue = 0
    
    Dim pTextSym As ITextSymbol
    Set pTextSym = New TextSymbol
    pTextSym.Color = pRGB
    
    pDocSym.TextSymbol = pTextSym

End Sub

IStatusBar

Sub StatusBar()
    Dim pApp As IApplication
    Set pApp = Application
    
    Dim pStatusBar As IStatusBar
    Set pStatusBar = pApp.StatusBar
    
    pStatusBar.Panes = 255
        '恢复默认，值为7
    Dim i As Long
    Dim pProgbar As IStepProgressor
    
    Set pProgbar = pStatusBar.ProgressBar
    pProgbar.Position = 0
    pStatusBar.ShowProgressBar "载入...", 0, 9000000, 1, True
    For i = 0 To 9000000
        pStatusBar.StepProgressBar
    Next
    pStatusBar.HideProgressBar
    
End Sub

IDockWindow接口

若是不移动窗口，则不必用到IWindowPosition接口~
IDockableWindowManager接口用来找到需要操作的窗口~

Sub MoveTOC()
    Dim pDocWinMgr As IDockableWindowManager
    Dim pTOC As IDockableWindow
    Dim pWinPos As IWindowPosition
    
    Set pDocWinMgr = Application
    Set pTOC = pDocWinMgr.GetDockableWindow(arcid.TableofContents)
    Set pWinPos = pTOC
    
    If pTOC.IsVisible Then
        'pTOC.Dock esriDockBottom   '低端显示
        'pTOC.Dock esriDockRight    '右端显示
        'pTOC.Dock esriDockLeft     '左端显示
        'pTOC.Dock esriDockTop      '顶端显示
        
        'pTOC.Dock esriDockFloat
        'pWinPos.Move 0, 80, 200, 900
    End If
End Sub

Sub MoveSearch()
    Dim pDocWinMgr As IDockableWindowManager
    Dim pSearch As IDockableWindow
    Dim pWinPos As IWindowPosition
    
    Set pDocWinMgr = Application
    Set pSearch = pDocWinMgr.GetDockableWindow(arcid.SearchDockableWindow)
    Set pWinPos = pSearch
    pSearch.Dock esriDockRight
End Sub

IAcceleratorTable接口

Sub AssignAccelerator()
    Dim pAccTable As IAcceleratorTable
    Set pAccTable = ThisDocument.Accelerators
    Dim addAcc As Boolean
    addAcc = pAccTable.Add(arcid.File_AddData, vbKeyD, True, False, False)
End Sub

加入快捷键，Ctrl，Alt，Shift~

ICommandBars和ICommandBar接口

Sub CreateBars()
    Dim pCmdBars As ICommandBars
    Set pCmdBars = ThisDocument.CommandBars
    
    Dim pNewBar As ICommandBar
    Set pNewBar = pCmdBars.Create("MyBar", esriCmdBarTypeToolbar)
    
    pNewBar.Add arcid.File_AddData
    pNewBar.Add arcid.PanZoom_FullExtent
    
    pNewBar.Dock esriDockBottom, pCmdBars.Find(arcid.Standard_Toolbar)
End Sub