ESRI ArcGIS应用与开发 [帝国首发]ArcGIS开发教材,0830更新,提问前请先看||做专业的GIS技术交流论坛

gis

管理员

注册日期2003-07-16
发帖数15947
QQ554730525
铜币25339枚
威望15364点
贡献值0点
银元0个

10楼^#

发布于：2005-07-26 10:56

本例要实现的是如何创建定制的可停靠窗口(Dockable Window)
l 要点
用户通过在类模块中实现IDockableWindowDef接口来创建定制的可停靠窗口(Dockable Window)。IDockableWindowDef接口包括Caption、ChildHWND，UserData及Name等属性和OnCreate、OnDestroy事件。
·ChildHWND属性表示可停靠窗口包含的Window的Handle。
·OnCreate事件的参数hook传入ArcGIS的Application实例。
·创建并注册可停靠窗口的步骤：
1、实现IdockableWindowDef接口(参见实例)；
2、编译成DLL；
3、调用windows目录下system32子目录下的regsvr32.exe用下面的形式注册编译好的DLL：
win目录\system32\regsvr32.exe <路径>\<文件名>.dll
4、运行<arcmap目录>\arcexe81\Bin\categories.exe,在打开的Component Catregory Manager中找到ESRI Mx Dockable Window,点击Add Object…按钮将上面注册的DLL文件加入，并选中实现IdockableWindowDef接口的类名即可。
l 程序说明
类模块 ClsDockableWindow只是创建与注册可停靠窗口，但还不能用，还必须定义一个IdockableWindow接口的变量引用注册的类（必须用IdockableWindowsManager接口的GetDockableWindow获取，其ID号用"实现IdockableWindowDef接口的工程名project1. 实现IdockableWindowDef接口的类名class1"）。
l 代码

<TABLE height=43 width=541 align=center border=0>

<TR>
<TD width=531>
'类模块 ClsDockableWindow Option Explicit Implements IDockableWindowDef Dim m_pApplication As IApplication 
Private Property Get IDockableWindowDef_Caption() As String IDockableWindowDef_Caption = "Dockable Window" End Property 
Private Property Get IDockableWindowDef_ChildHWND() As esriCore.OLE_HANDLE '将FrmDWin窗口的Handle赋给IDockableWindowDef_ChildHWND IDockableWindowDef_ChildHWND = FrmDWin.hWnd End Property 
Private Property Get IDockableWindowDef_Name() As String IDockableWindowDef_Name = "docwin" End Property 
Private Sub IDockableWindowDef_OnCreate(ByVal hook As Object) Set m_pApplication = hook End Sub 
Private Sub IDockableWindowDef_OnDestroy() Set m_pApplication = Nothing End Sub 
Private Property Get IDockableWindowDef_UserData() As Variant End Property 
'类模块 class1 Option Explicit Implements ICommand Dim m_pApp As IApplication Dim m_pDWMgr As IDockableWindowManager Dim m_pDWin As IDockableWindow 
Private Property Get ICommand_Bitmap() As esriCore.OLE_HANDLE End Property 
Private Property Get ICommand_Caption() As String ICommand_Caption = "Dockable Window" End Property 
Private Property Get ICommand_Category() As String ICommand_Category = "Dockable Window" End Property 
Private Property Get ICommand_Checked() As Boolean End Property 
Private Property Get ICommand_Enabled() As Boolean ICommand_Enabled = True End Property 
Private Property Get ICommand_HelpContextID() As Long End Property 
Private Property Get ICommand_HelpFile() As String End Property 
Private Property Get ICommand_Message() As String End Property 
Private Property Get ICommand_Name() As String ICommand_Name = "DocWin" End Property 
Private Sub ICommand_OnClick() m_pDWin.Show Not m_pDWin.IsVisible End Sub 
Private Sub ICommand_OnCreate(ByVal hook As Object) Set m_pApp = hook ' QI(Dockable Window) Set m_pDWMgr = hook Dim pid As New UID pid.Value = "Prodockablewindow.Clsdockablewindow" Set m_pDWin = m_pDWMgr.GetDockableWindow(pid) End Sub 
Private Property Get ICommand_Tooltip() As String ICommand_Tooltip = "Dockable Window" End Property</TD></TR></TABLE>

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15947
QQ554730525
铜币25339枚
威望15364点
贡献值0点
银元0个

加关注写私信

11楼^#

发布于：2005-07-26 10:56

本例要实现的是如何创建、使用定制的Extension
 要点
用户需要实现IExtension接口来创建定制的Extension。IExtension接口包括Name属性和startup和shutdown事件。
·创建并注册Extension的步骤：
1．实现IExtension接口；
2．编译成DLL；
3．调用windows目录下system32子目录下的regsvr32.exe用下面的形式注册编译好的DLL
win目录\system32\regsvr32.exe <路径>\<文件名>.dll
4．运行<arcmap目录>\arcexe81\Bin\categories.exe,在打开的Component Catregory Manager中找到ESRI Mx Extensions,点击Add Object…按钮将上面注册的DLL文件加入，并选中实现IExtension接口的类名即可。
l 程序说明
用户通过在类模块中实现IExtension接口来创建定制的Extension。Extension将在ArcMap打开时自动加载，在ArcMap关闭时自动卸载。
l 代码

<TABLE height=43 width=541 align=center border=0>

<TR>
<TD width=531>
Option Explicit Implements IExtension Dim m_pApplication As IApplication ' Need to listen for the MxDocument events Dim WithEvents m_pDocument As MxDocument 
 Private Property Get IExtension_Name() As String IExtension_Name = "My Extension" End Property 
 Private Sub IExtension_Shutdown() ' Clear the reference to the Application and MxDocument Set m_pApplication = Nothing Set m_pDocument = Nothing End Sub 
Private Sub IExtension_Startup(initializationData As Variant) ' This extension is an ArcMap Extension. When this extension in loaded on ' ArcMap startup, initializationData is passed in as a reference to the ' Application object Set m_pApplication = initializationData 'Start listening for the MxDocument events. Set m_pDocument = m_pApp.Document End Sub 
 Private Function m_pDocument_NewDocument() As Boolean ' Do something when a new document is created MsgBox "Creating a new document." End Function 
 Private Function m_pDocument_OpenDocument() As Boolean ' So something when a document is opened. MsgBox "Opening a document" End Function</TD></TR></TABLE>

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15947
QQ554730525
铜币25339枚
威望15364点
贡献值0点
银元0个

加关注写私信

12楼^#

发布于：2005-07-26 10:57

如何使用状态条(StatusBar)与进度条(ProgressBar)
本例要演示的是如何使用状态条(StatusBar)与进度条(ProgressBar)。实现后的结果为在ArcMap中，状态条位于其底部，它显示ArcMAP当前状态的信息，包含进度条。
l 要点
一般情况下，通过ArcMAP的Application实例获取IstatusBar的实例,然后再通过StatusBar获取IprogressBar的实例,并将IprogressBar的实例赋给IstepProgressor类型的变量。
l 程序说明
运行函数ShowProgress将在ArcMap的下方添加一个状态条(StatusBar)和进度条(ProgressBar)。
l 代码

<TABLE height=43 width=541 align=center border=0>

<TR>
<TD width=531>
Sub ShowProgress() On Error GoTo err1 Dim pDocument As IMxDocument Dim pMap As IMap Dim pLayer As ILayer Dim pFeatureLayer As IFeatureLayer Dim pFeatureCursor As IFeatureCursor Dim pFeatureClass As IFeatureClass Dim pFeature As IFeature Dim dSum As Double Dim lFieldIndex As Long Dim lNumFeat As Long Dim dInterval As Double Set pDocument = Application.Document Set pMap = pDocument.FocusMap Set pLayer = pMap.Layer(0) Set pFeatureLayer = pLayer Set pFeatureClass = pFeatureLayer.FeatureClass Set pFeatureCursor = pFeatureLayer.Search(Nothing, True) Dim pStatusBar As IStatusBar Set pStatusBar = Application.StatusBar Dim pStepProgressor As IStepProgressor Set pStepProgressor= pStatusBar.ProgressBar lNumFeat = pFeatureClass.FeatureCount(Nothing) dInterval = lNumFeat / 100 Set pFeature = pFeatureCursor.NextFeature ' 字段名"FID"用户根据实际而改变 lFieldIndex = pFeature.Fields.FindField("FID") Dim PauseTime, Start, Finish, TotalTime, i PauseTime = 0.5 pStepProgressor.MinRange = 1 pStepProgressor.MaxRange = lNumFeat pStepProgressor.StepValue = dInterval For i = 1 To lNumFeat dSum = dSum + pFeature.Value(lFieldIndex) Set pFeature = Nothing Set pFeature = pFeatureCursor.NextFeature pStepProgressor.Position = i pStepProgressor.Message = "Reading record " ; Str(i) ; ". Sum =" ; Str(dSum) pStepProgressor.Step pStepProgressor.Show Start = Timer Do While Timer < Start + PauseTime DoEvents Loop Next pStepProgressor.Hide Exit Sub err1: MsgBox Err.Description End Sub</TD></TR></TABLE>

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15947
QQ554730525
铜币25339枚
威望15364点
贡献值0点
银元0个

加关注写私信

13楼^#

发布于：2005-07-26 10:58

如何使用ArcGIS的对话框
添加对话框可以通过相应的接口实现。比如“添加数据对话框”使用IaddDataDialog接口，“生成点坐标对话框” 使用ICoordinateDialog接口，“生成字符串对话框”使用IGetStringDialog接口，“生成数值对话框”使用INumberDialog接口等等。本例以添加数据对话框(Add Data Dialog)为例，讲述对话框是如何通过接口实现添加的。
l 要点
用户通过实现IaddDataDialog接口来创建定制的添加数据对话框，IaddDataDialog接口包括Document和Map属性和Show事件。
l 程序说明
在程序中除了必须生成IaddDataDialog接口的实例外，还必须指定对话框的Document和Map。当为AddDataDialog指定Document和Map之后，系统会自动将用户选择的数据加入到指定Document和Map中。最后实现在ArcMap中添加数据的对话框。
l 代码

<TABLE height=43 width=541 align=center border=0>

<TR>
<TD width=531>
Sub ShowProgress() Dim mDocument As IMxDocument Dim mAddDataDialog As IAddDataDialog Set mAddDataDialog = New AddDataDialog Set mDocument = ThisDocument mAddDataDialog.Document = mDocument mAddDataDialog.Map = mDocument.FocusMap mAddDataDialog.Show Application.hWnd, True End Sub</TD></TR></TABLE>

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15947
QQ554730525
铜币25339枚
威望15364点
贡献值0点
银元0个

加关注写私信

14楼^#

发布于：2005-07-26 10:58

如何调用ArcMap中现有的功能
如何调用ArcMap中现有的功能，比如菜单栏、工具栏中的某些功能。这些都可以通过UID来实现。本例是通过UID调用“另存为”功能。
可以通过两种方法得到UID:
方法一：运用ArcID模块
l 要点
通过ArcID获得UID,ArcID是ArcMap的VBA中的模块。只需要知道要调用功能的名称运用代码就可以实现。
l 程序说明
程序通过运用ArcID模块和命令名称来实现调用“另存为”的功能。
l 代码
Sub ExecuteCmd() Dim pCommandItem As ICommandItem ' Use ArcID module and the Name of the SaveAs command Set pCommandItem = Application.Document.CommandBars.Find(arcid.File_SaveAs) pCommandItem.Execute End Sub
方法二：直接写代码
l 要点
通过直接写代码获得UID实现调用功能。
l 程序说明
写入文件菜单项的GUID(CLSID或ProgID)来调用文件菜单项，同时还需要通过设置Subtype的值来调用文件菜单项的“另存为”功能。
l 代码

<TABLE height=43 width=541 align=center border=0>

<TR>
<TD width=531>
Sub ExecuteCmd2() Dim pUID As New UID Dim pCommandItem As ICommandItem ' Use the GUID of the Save command pUID.Value = "{119591DB-0255-11D2-8D20-080009EE4E51}" ' or you can use the ProgID ' pUID.Value = "esriCore.MxFileMenuItem" pUID.SubType = 3 Set pCommandItem = Application.Document.CommandBars.Find(pUID) pCommandItem.Execute End Sub</TD></TR></TABLE>

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15947
QQ554730525
铜币25339枚
威望15364点
贡献值0点
银元0个

加关注写私信

15楼^#

发布于：2005-07-26 10:59

如何创建放大镜(虫眼)
 
本例要实现的是如何创建放大镜(虫眼)，将所选区域放大一定的倍数。
l 要点
用户通过定义IMapInset、IMapInsetWindow、IDataWindowFactory三个接口，运用它们的方法、属性来创建放大镜(虫眼)。
l 程序说明
运用这个子程序生成了一个新的放大镜窗口，在本例中将放大率设定为200%代替原来的400%。
l 代码

<TABLE height=43 width=541 align=center border=0>

<TR>
<TD width=531>
Public Sub CreateMagnifierWindow() Dim pMapInset As IMapInset Dim pMapInsetWindow As IMapInsetWindow Dim pDataWindowFactory As IDataWindowFactory Set pDataWindowFactory = New MapInsetWindowFactory If pDataWindowFactory.CanCreate(Application) Then Set pMapInsetWindow = pDataWindowFactory.Create(Application) Set pMapInset = pMapInsetWindow.MapInset 'Set the zoom percent to 200% pMapInset.ZoomPercent = 200 pMapInsetWindow.Show True End If End Sub</TD></TR></TABLE>

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15947
QQ554730525
铜币25339枚
威望15364点
贡献值0点
银元0个

加关注写私信

16楼^#

发布于：2005-07-26 11:00

如何加载Shape文件
 本例实现的是在ArcMap中连接指定的Shape文件，并将其加载到当前激活的Map中。 
 l 要点
通过FeatureLayer类实现IFeatureLayer接口对象，设置IFeatureLayer.FeatureClass属性和Name属性，使用IMap.AddLayer方法将新层添加到当前地图。利用IWorkspaceFacktory接口、IFeatureWorkspace接口和IFeatureLayer接口实现连接Shape文件
 l 程序说明
函数OpenShapeFile根据输入的Shape文件路径sFilePath，将文件名为sFileName的Shape文件连接到当前激活的Map中去。
 l 代码
<TABLE height=43 width=541 align=center border=0>

<TR>
<TD vAlign=top width=535 height=75>
Private Sub OpenShapeFile(ByVal sFilePath As String, ByVal sFileName As String)
 Dim pWorkspaceFactory As IWorkspaceFactory Dim pFeatureWorkspace As IFeatureWorkspace Dim pFeatureLayer As IFeatureLayer Dim pMxDocument As IMxDocument Dim pMap As IMap Dim sDir As String 
On Error GoTo ErrorHandler:
 sDir = Dir(sFilePath ; "\" ; sFileName ; ".shp") If (sDir = "") Then sDir = Dir(sFilePath ; "\" ; sFileName) If (sDir = "") Then MsgBox ("文件不存在") Exit Sub End If End If
 'Create a new ShapefileWorkspaceFactory object and open a shapefile folder Set pWorkspaceFactory = New ShapefileWorkspaceFactory Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0) 'Create a new FeatureLayer and assign a shapefile to it Set pFeatureLayer = New FeatureLayer Set pFeatureLayer.FeatureClass = pFeatureWorkspace.OpenFeatureClass(sFileName) pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName
 'Add the FeatureLayer to the focus map Set pMxDocument = Application.Document Set pMap = pMxDocument.FocusMap pMap.AddLayer pFeatureLayer
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub
Private Sub UIButtonControl1_Click()
 Dim pVBProject As VBProject
On Error GoTo ErrorHandler:
 Set pVBProject = ThisDocument.VBProject OpenShapeFile pVBProject.FileName ; "\..\..\..\.." ; "\data\", "Continents"
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub</TD></TR></TABLE>

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15947
QQ554730525
铜币25339枚
威望15364点
贡献值0点
银元0个

加关注写私信

17楼^#

发布于：2005-07-26 11:01

如何在ArcMap中加入Text和dBASE文件
l 要点
首先为Text文件或dBASE文件创建一个与之对应的ITable接口对象，然后通过IMap实例获得IStandaloneTable接口对象和IStandaloneTableCollection接口对象，并设置其属性，最后使用IStandaloneTableCollection.AddStandaloneTable方法将Text文件或dBASE文件加入到当前的ArcMap中。加入Text文件或dBASE文件的区别仅在于创建ITable对象时IWorkspaceFactory的类型不同，加入Text文件时是TextFileWorkspaceFactory类型，加入dBASE文件时是ShapefileWorkspaceFactory类型。
主要用到了IWorkspaceFactory接口，IWorkspace接口，IFeatureWorkspace接口，ITable接口，IStandaloneTable接口和IStandaloneTableCollection接口。
 l 程序说明
函数AddTextFile通过文件路径sFilePath和文件名sFileName找到Text文件并为其创建ITable对象
函数AddDBASEFile通过文件路径sFilePath和文件名sFileName找到dBASE文件并为其创建ITable对象
函数Add_Table_TOC将ITable对象pTable加入到当前的ArcMap中。
 l 代码

<TABLE height=43 width=541 align=center border=0>

<TR>
<TD vAlign=top width=535 height=75>
Private Sub AddTextFile(ByVal sFilePath As String, ByVal sFileName As String)
 Dim pWorkspaceFactory As IWorkspaceFactory Dim pWorkspace As IWorkspace Dim pFeatureWorkspace As IFeatureWorkspace Dim pTable As ITable Dim sDir As String 
On Error GoTo ErrorHandler:
 sDir = Dir(sFilePath ; sFileName ; ".txt") If (sDir = "") Then MsgBox (sFileName ; ".txt" ; " 文件不存在") Exit Sub End If
 'Get the ITable from the geodatabase Set pWorkspaceFactory = New TextFileWorkspaceFactory Set pWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0) Set pFeatureWorkspace = pWorkspace Set pTable = pFeatureWorkspace.OpenTable(sFileName ; ".txt")
 'Add the table Add_Table_TOC pTable
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub
Private Sub AddDBASEFile(ByVal sFilePath As String, ByVal sFileName As String)
 Dim pWorkspaceFactory As IWorkspaceFactory Dim pWorkspace As IWorkspace Dim pFeatureWorkspace As IFeatureWorkspace Dim pTable As ITable
On Error GoTo ErrorHandler:
 'Get the ITable from the geodatabase Set pWorkspaceFactory = New ShapefileWorkspaceFactory Set pWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0) Set pFeatureWorkspace = pWorkspace Set pTable = pFeatureWorkspace.OpenTable(sFileName)
 'Add the table Add_Table_TOC pTable
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub
Private Sub Add_Table_TOC(pTable As ITable)
 Dim pDoc As IMxDocument Dim pMap As IMap Dim pStandaloneTable As IStandaloneTable Dim pStandaloneTableC As IStandaloneTableCollection
On Error GoTo ErrorHandler:
 Set pDoc = ThisDocument Set pMap = pDoc.FocusMap
 'Create a new standalone table and add it 'to the collection of the focus map Set pStandaloneTable = New StandaloneTable Set pStandaloneTable.Table = pTable Set pStandaloneTableC = pMap pStandaloneTableC.AddStandaloneTable pStandaloneTable
 'Refresh the TOC pDoc.UpdateContents
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub
Private Sub UIButtonControl1_Click()
 Dim pVBProject As VBProject
On Error GoTo ErrorHandler:
 Set pVBProject = ThisDocument.VBProject
 'Add text file to ArcMap. Dont include .txt extension AddTextFile pVBProject.FileName ; "\..\..\..\.." ; "\data\", "Continents"
 'Add dBASE file to ArcMap AddDBASEFile pVBProject.FileName ; "\..\..\..\.." ; "\data\", "Continents"
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub</TD></TR></TABLE>

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15947
QQ554730525
铜币25339枚
威望15364点
贡献值0点
银元0个

加关注写私信

18楼^#

发布于：2005-07-26 11:02

如何连接Coverage文件
本例实现的是如何在当前激活的Map中连接一个Coverage文件。
 l 要点
使用ArcInfoWorkspaceFactory类实现IWorkSpaceFactory接口对象，用IWorkspaceFactory.Open方法打开一个Workspace，并获得Dataset对象。由于此时的Dataset对象可能有多个Coverage文件，所以要获得IEnumDataset接口对象，通过IEnumDataset.Next方法获得一个Coverage文件，并将其所有的FeatureClass放在IFeatureClassContainer对象中。最后通过IFeatureClassContainer.Class方法获得IFeatureClass接口实例，用IMap.AddLayer方法将要连接的Coverage文件的所有FeatureClass加载到当前激活的Map中。
主要用到IWorkspaceFactory接口，IWorkspace接口，IPropertySet接口，IDataset接口，IEnumDataset接口，IFeatureClassContainer接口。
 l 程序说明
函数ConnectCoverageFile将sFilePath指定的ArcInfo Workspace中的名称和sFileName相同的Coverage文件加载到当前激活的Map中。
 l 代码

<TABLE height=43 width=541 align=center border=0>

<TR>
<TD vAlign=top width=535 height=75>
Private Sub ConnectCoverageFile(ByVal sFilePath As String, ByVal sFileName As String)
 Dim pWorkspace As IWorkspace Dim pWorkspaceFactory As IWorkspaceFactory Dim pPropertySet As IPropertySet Dim pDataset As IDataset Dim pEnumDataset As IEnumDataset Dim pFeatureClassC As IFeatureClassContainer Dim pFeatureLayer As IFeatureLayer Dim pMxDocument As IMxDocument Dim pMap As IMap Dim nNumber As Integer Dim sWorkspace As String
On Error GoTo ErrorHandler:
 sWorkspace = Dir(sFilePath, vbDirectory) If (sWorkspace = "") Then MsgBox ("文件不存在") Exit Sub End If
 Set pWorkspaceFactory = New ArcInfoWorkspaceFactory Set pPropertySet = New PropertySet
 'canada is an arcinfoworkspace pPropertySet.SetProperty "DATABASE", sFilePath
 'pWorkSp is a pointer to the IArcInfoWorkspace Set pWorkspace = pWorkspaceFactory.Open(pPropertySet, 0)
 'now get to dataset objects using Idataset Set pDataset = pWorkspace
 'use enum to get datasets Set pEnumDataset = pDataset.Subsets
 pEnumDataset.Reset
 'use FeatureClassContainer to get datasets Set pFeatureClassC = pEnumDataset.Next
 Do While Not pFeatureClassC Is Nothing Set pDataset = pFeatureClassC If (pDataset.Name <> sFileName) Then Set pFeatureClassC = pEnumDataset.Next Else Exit Do End If Loop
 'add FeatureClassContainer to map If (pFeatureClassC Is Nothing) Then MsgBox ("文件不存在") Else nNumber = 0 Set pMxDocument = ThisDocument Set pMap = pMxDocument.FocusMap Do While nNumber < pFeatureClassC.ClassCount Set pFeatureLayer = New FeatureLayer Set pFeatureLayer.FeatureClass = pFeatureClassC.Class(nNumber) pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName nNumber = nNumber + 1 pMap.AddLayer pFeatureLayer Loop End If
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub
Private Sub UIButtonControl1_Click()
 Dim pVBProject As VBProject
On Error GoTo ErrorHandler:
 Set pVBProject = ThisDocument.VBProject ConnectCoverageFile pVBProject.FileName ; "\..\..\..\.." ; "\data\canada", "canada"
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub</TD></TR></TABLE>

举报回复喜欢评分

gis

管理员

注册日期2003-07-16
发帖数15947
QQ554730525
铜币25339枚
威望15364点
贡献值0点
银元0个

加关注写私信

19楼^#

发布于：2005-07-26 11:02

如何连接栅格文件
 
本例实现的是如何在当前激活的Map中添加一个栅格文件。
 l 要点
创建一个IrasterLayer接口对象，使用IRasterLayer.CreateFromFilePath方法加载一个Raster文件，最后用IMap.AddLayer方法将IRasterLayer添加到当前激活的Map中。
主要用到IRasterLayer接口。
 l 程序说明
函数AddRasterFile将路径sFilePath下的栅格文件sFileName添加到当前激活的Map中。
 l 代码

<TABLE height=43 width=541 align=center border=0>

<TR>
<TD vAlign=top width=535 height=75>
Private Sub AddRasterFile(sFilePath As String, sFileName As String)
 'sFileName: the filename of the raster dataset 'sPath: the directory where the raster dataset resides
 Dim pRasterLy As IRasterLayer Dim pMxDoc As IMxDocument Dim pMap As IMap Dim sRasterFile As String
On Error GoTo ErrorHandler:
 sRasterFile = Dir(sFilePath ; sFileName) If (sRasterFile = "") Then MsgBox ("文件不存在") Exit Sub End If
 'Create a raster layer Set pRasterLy = New RasterLayer
 'This is only one of the three ways to create a RasterLayer object. 'If there is already a Raster or RasterDataset object, then 'method CreateFromDataset or CreateFromRaster can be used. pRasterLy.CreateFromFilePath sFilePath ; sFileName
 'Add the raster layer to ArcMap Set pMxDoc = ThisDocument Set pMap = pMxDoc.FocusMap pMap.AddLayer pRasterLy pMxDoc.ActiveView.Refresh
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub
Private Sub UIButtonControl1_Click()
 Dim pVBProject As VBProject
On Error GoTo ErrorHandler:
 Set pVBProject = ThisDocument.VBProject AddRasterFile pVBProject.FileName ; "\..\..\..\.." ; "\data\", "photo.tif"
 Exit Sub
ErrorHandler: MsgBox Err.Description
End Sub</TD></TR></TABLE>

举报回复喜欢评分

您需要登录后才可以回帖，登录或者注册