本例演示的是如何将shape文件转化成personal GeoDatabase文件,其它格式间的与此转换类似。主要用到IFeatureDataConverter接口的ConvertFeatureClass方法。
要点
首先,创建新的GeoDataBase数据库,并创建IFeatureDatasetName对象。创建定义两个IFeatureClassName接口对象分别引用输入表(shape文件)和输出表。
然后设置输出表的Shape字段的GeormetryDef属性。这一步非常关键,因为其中包含了数据库和shape文件的空间参考信息。
最后调用IFeatureDataConverter.ConvertFeatureClass方法完成功能。
程序说明
过程UIBConvert_Click是实现模块,调用过程ConvertShapeToGeodatabase实现功能。
sDataPath定义了数据与工程文件的相对路径。SHAPE_NAME描述了要转化的shape文件的文件名。MDB_NAME和F_DS_NAME分别描述了Access数据库名和库的数据集的名称。
代码
Option Explicit
Private Sub UIBConvert_Click()
Call ConvertShapeToGeodatabase
End Sub
Private Sub ConvertShapeToGeodatabase()
Dim pOutWorkspaceFactory As IWorkspaceFactory
Dim pOutWorkspaceName As IWorkspaceName
Dim pInWorkspaceName As IWorkspaceName
Dim pOutFeatureDSName As IFeatureDatasetName
Dim pOutDSName As IDatasetName
Dim pInFeatureClassName As IFeatureClassName
Dim pInDatasetName As IDatasetName
Dim pOutFeatureClassName As IFeatureClassName
Dim pOutDatasetName As IDatasetName
Dim iCounter As Long
Dim pOutFields As IFields
Dim pInFields As IFields
Dim pFieldChecker As IFieldChecker
Dim pGeoField As IField
Dim pOutGeometryDef As IGeometryDef
Dim pOutGeometryDefEdit As IGeometryDefEdit
Dim pName As IName
Dim pInFeatureClass As IFeatureClass
Dim pShpToFeatClsConverter As IFeatureDataConverter
Dim pVBProject As VBProject
Dim sDataPath As String
Const SHAPE_NAME As String = "country"
Const MDB_NAME As String = "countryDB"
Const F_DS_NAME As String = "World"
On Error GoTo ErrorHandler
Set pVBProject = ThisDocument.VBProject
sDataPath = pVBProject.FileName & "\..\..\..\..\data\"
If Not "" = Dir(sDataPath & MDB_NAME & ".mdb") Then
MsgBox MDB_NAME & ".mdb already exist"
Exit Sub
Else
' Create a new Access database
Set pOutWorkspaceFactory = New AccessWorkspaceFactory
Set pOutWorkspaceName = pOutWorkspaceFactory.Create(sDataPath, MDB_NAME, Nothing, 0)
' create a new feature datset name object for the output Access feature dataset, call
' it "World"
Set pOutFeatureDSName = New FeatureDatasetName
Set pOutDSName = pOutFeatureDSName
Set pOutDSName.WorkspaceName = pOutWorkspaceName
pOutDSName.Name = F_DS_NAME
' Get the name object for the input shapefile workspace
Set pInWorkspaceName = New WorkspaceName
pInWorkspaceName.PathName = sDataPath
pInWorkspaceName.WorkspaceFactoryProgID = _
"esriCore.ShapefileWorkspaceFactory.1"
Set pInFeatureClassName = New FeatureClassName
Set pInDatasetName = pInFeatureClassName
pInDatasetName.Name = SHAPE_NAME
Set pInDatasetName.WorkspaceName = pInWorkspaceName
' Create the new output FeatureClass name object that will be passed
' into the conversion function
Set pOutFeatureClassName = New FeatureClassName
Set pOutDatasetName = pOutFeatureClassName
' Set the new FeatureClass name to be the same as the input FeatureClass name
pOutDatasetName.Name = pInDatasetName.Name
' Open the input Shapefile FeatureClass object, so that we can get its fields
Set pName = pInFeatureClassName
Set pInFeatureClass = pName.Open
' Get the fields for the input feature class and run them through
' field checker to make sure there are no illegal or duplicate field names
Set pInFields = pInFeatureClass.Fields
Set pFieldChecker = New FieldChecker
pFieldChecker.Validate pInFields, Nothing, pOutFields
' Loop through the output fields to find the geometry field
For iCounter = 0 To pOutFields.FieldCount
If pOutFields.Field(iCounter).Type = esriFieldTypeGeometry Then
Set pGeoField = pOutFields.Field(iCounter)
Exit For
End If
Next iCounter
' Get the geometry field's geometry definition
Set pOutGeometryDef = pGeoField.GeometryDef
' Give the geometry definition a spatial index grid count and grid size
Set pOutGeometryDefEdit = pOutGeometryDef
pOutGeometryDefEdit.GridCount = 1
pOutGeometryDefEdit.GridSize(0) = 1500000
' Now use IFeatureDataConverter::Convert to create the output FeatureDataset and
' FeatureClass.
Set pShpToFeatClsConverter = New FeatureDataConverter
pShpToFeatClsConverter.ConvertFeatureClass pInFeatureClassName, Nothing, _
pOutFeatureDSName, pOutFeatureClassName, Nothing, pOutFields, "", 1000, 0
MsgBox "Convert operation complete!", vbInformation
End If
Exit Sub
ErrorHandler:
MsgBox Err.Description
End Sub