MsgBox Err.Description End Sub
1.3.5. 如何连接栅格文件
本例实现的是如何在当前激活的Map中添加一个栅格文件。 ? 要点
创建一个IrasterLayer接口对象，使用IRasterLayer.CreateFromFilePath方法加载一个Raster文件，最后用IMap.AddLayer方法将IRasterLayer添加到当前激活的Map中。
主要用到IRasterLayer接口。 ? 程序说明
函数AddRasterFile将路径sFilePath下的栅格文件sFileName添加到当前激活的Map中。 ? 代码
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 = \ 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()
-36-
Dim pVBProject As VBProject On Error GoTo ErrorHandler:
Set pVBProject = ThisDocument.VBProject
AddRasterFile pVBProject.FileName & \ Exit Sub ErrorHandler:
MsgBox Err.Description End Sub
1.3.6. 如何创建Shape文件
本例实现的是如何创建一个Shape文件。 ? 要点
首先创建新IField接口实例，生成新字段，并获得该实例的IFieldEdit接口对象，用FieldsEdit的AddField方法将新字段加入到IFields接口对象中，最后用IFeatureWorkspace的CreateFeatureClass方法生成新的Shape文件
主要用到IFeatureWorkspace接口，IWorkspaceFactory接口，IFieldsEdit接口，IFieldEdit接口，IFeatureClass接口。 ? 程序说明
函数CreatShapeFile根据输入的文件路径和文件名，创建Shape文件。 ? 代码
Private Sub CreatShapeFile(ByVal sFilePath As String, ByVal sFileName As String) Dim pFeatureWorkspace As IFeatureWorkspace Dim pWorkspaceFactory As IWorkspaceFactory Dim pFields As IFields Dim pFieldsEdit As IFieldsEdit Dim pField As IField Dim pFieldEdit As IFieldEdit Dim pGeometryDef As IGeometryDef Dim pGeometryDefEdit As IGeometryDefEdit Dim pFeatClass As IFeatureClass Dim sShapeFieldName As String Dim sNewShapeFileName As String
On Error GoTo ErrorHandler:
sNewShapeFileName = Dir(sFilePath & sFileName & \ If (sNewShapeFileName <> \ MsgBox (\文件已经存在\ Exit Sub End If
sShapeFieldName = \
'Open the folder to contain the shapefile as a workspace Set pWorkspaceFactory = New ShapefileWorkspaceFactory
Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0)
-37-
'Set up a simple fields collection Set pFields = New esriCore.Fields Set pFieldsEdit = pFields
'Make the shape field
'it will need a geometry definition, with a spatial reference Set pField = New esriCore.Field Set pFieldEdit = pField
pFieldEdit.Name = sShapeFieldName
pFieldEdit.Type = esriFieldTypeGeometry
Set pGeometryDef = New GeometryDef Set pGeometryDefEdit = pGeometryDef With pGeometryDefEdit
.GeometryType = esriGeometryPolygon
Set .SpatialReference = New UnknownCoordinateSystem End With
Set pFieldEdit.GeometryDef = pGeometryDef pFieldsEdit.AddField pField
'Add others miscellaneous text field Set pField = New esriCore.Field Set pFieldEdit = pField With pFieldEdit
.Name = \
.Type = esriFieldTypeSmallInteger End With
pFieldsEdit.AddField pField
Set pField = New esriCore.Field Set pFieldEdit = pField With pFieldEdit
.Name = \
.Type = esriFieldTypeInteger End With
pFieldsEdit.AddField pField
Set pField = New esriCore.Field Set pFieldEdit = pField With pFieldEdit
.Name = \
.Type = esriFieldTypeSingle End With
pFieldsEdit.AddField pField
Set pField = New esriCore.Field Set pFieldEdit = pField With pFieldEdit .Precision = 5 .Scale = 5
.Name = \
.Type = esriFieldTypeDouble End With
pFieldsEdit.AddField pField
-38-
Set pField = New esriCore.Field Set pFieldEdit = pField With pFieldEdit .Length = 30 .Name = \
.Type = esriFieldTypeString End With
pFieldsEdit.AddField pField
Set pField = New esriCore.Field Set pFieldEdit = pField With pFieldEdit .Name = \
.Type = esriFieldTypeDate End With
pFieldsEdit.AddField pField
'Create the shapefile
'(some parameters apply to geodatabase options and can be defaulted as Nothing) Set pFeatClass = pFeatureWorkspace.CreateFeatureClass _ (sFileName, pFields, Nothing, Nothing, _ esriFTSimple, sShapeFieldName, \
sNewShapeFileName = Dir(sFilePath & \ If (sNewShapeFileName = \ MsgBox (\ Else
MsgBox (\ 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
'Dont include .shp extension
CreatShapeFile pVBProject.FileName & \ Exit Sub ErrorHandler:
MsgBox Err.Description End Sub
Private Sub UIButtonControl1_Click()
Dim pVBProject As VBProject On Error GoTo ErrorHandler:
Set pVBProject = ThisDocument.VBProject
'Dont include .shp extension
CreatShapeFile pVBProject.FileName & \ Exit Sub ErrorHandler:
-39-
MsgBox Err.Description End Sub
1.3.7. 如何创建DBF文件
本例要实现的是如何创建一个单独的DBF文件。 ? 要点
首先设定DBF文件的字段个数，再创建新的IField对象，生成新字段，设置其属性，再加入到IFields对象中，最后用IFeatureWorkspace.CreateTable方法创建一个新的DBF文件并返回ITable对象。
主要用到IField接口，IFieldEdit接口，IFields接口，IFieldsEdit接口。 ? 程序说明
函数CreateDBF根据输入的路径和文件名创建一个DBF文件并返回一个ITable对象。 ? 代码
Private Function CreateDBF (sFilePath As String, sFileName As String) As ITable 'createDBF: simple function to create a DBASE file.
'note: the name of the DBASE file should not contain the .dbf extension
On Error GoTo ErrorHandler:
Dim pFeatureWorkspace As IFeatureWorkspace Dim pWorkspaceFactory As IWorkspaceFactory
Dim FileFolder As New Scripting.FileSystemObject Dim pFieldsEdit As esriCore.IFieldsEdit Dim pFieldEdit As esriCore.IFieldEdit Dim pFields As IFields Dim pField As IField Dim sDir As String
'Open the Workspace
Set pWorkspaceFactory = New ShapefileWorkspaceFactory If Not FileFolder.FolderExists(sFilePath) Then MsgBox \路径不存在\ Exit Function End If
sDir = Dir(sFilePath & sFileName & \ If (sDir <> \
MsgBox (\文件已存在\ Exit Function End If
Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0)
'if a fields collection is not passed in then create one
-40-