alex_bn_lee

导航

< 2025年3月 >
23 24 25 26 27 28 1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30 31 1 2 3 4 5

统计

【C006】ArcGIS VBA - IMap & ILayer

 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









 

 
























 

 

 

posted on   McDelfino  阅读(596)  评论(0编辑  收藏  举报

编辑推荐:
· AI与.NET技术实操系列(二):开始使用ML.NET
· 记一次.NET内存居高不下排查解决与启示
· 探究高空视频全景AR技术的实现原理
· 理解Rust引用及其生命周期标识(上)
· 浏览器原生「磁吸」效果!Anchor Positioning 锚点定位神器解析
阅读排行:
· DeepSeek 开源周回顾「GitHub 热点速览」
· 记一次.NET内存居高不下排查解决与启示
· 物流快递公司核心技术能力-地址解析分单基础技术分享
· .NET 10首个预览版发布:重大改进与新特性概览!
· .NET10 - 预览版1新功能体验(一)
点击右上角即可分享
微信分享提示