|
阅读:1104回复:1
[转帖]常用数据入sde库的代码
'****************************************************************<BR>'函数功能: 将矢量要素导入到指定数据库的数据集中,可以将shapefile,dxf,coverage格式导入倒GEodatabase中<BR>' 参数表:<BR>' pInDatasetNameCol 一个存储要导入的矢量要素(IFeatureClassName类型)的Collection对象<BR>' pOutNameCol 一个存储导入的矢量要素名称(string类型)的Collection对象<BR>' strGDBPath 包含矢量要素数据集名称的GDB路径,如“D:\world\Map3D.mdb”<BR>'****************************************************************<BR>Public Function convFeatureClass(pInDatasetNameCol As Collection, pOutNameCol As Collection, strGDBPath As String)<BR>'获得导入数据的数目<BR>Dim iInFCNum As Integer<BR>iInFCNum = pInDatasetNameCol.Count<BR>'获得输出的数据库名和数据集名<BR>Dim sOutFDSName As String<BR>Dim sOutGDBName As String<BR>sOutFDSName = GetPathName(strGDBPath, 1)<BR>sOutGDBName = GetPathName(strGDBPath, 0)<BR>'获得输出要素集的IFeatureDatasetName<BR>Dim pWSF As IWorkspaceFactory<BR>Set pWSF = New AccessWorkspaceFactory<BR>Dim pWS As IWorkspace<BR>Set pWS = pWSF.OpenFromFile(sOutGDBName, 0)<BR>Dim pOutFeatureWS As IFeatureWorkspace<BR>Set pOutFeatureWS = pWS<BR>'获得输出要素集的Dataset Name<BR>Dim pOutFDSName As IFeatureDatasetName<BR>Dim pOutFDS As IFeatureDataset<BR>Set pOutFDS = pOutFeatureWS.OpenFeatureDataset(sOutFDSName)<BR>Set pOutFDSName = pOutFDS.FullName<BR>Dim i As Integer<BR>For i = 1 To iInFCNum<BR> Dim pOutPropertySet As IPropertySet<BR> Set pOutPropertySet = New PropertySet<BR> pOutPropertySet.SetProperty "DATASET", sOutGDBName<BR> <BR> Dim pOutWorkspaceName As IWorkspaceName<BR> Set pOutWorkspaceName = New WorkspaceName<BR> pOutWorkspaceName.ConnectionProperties = pOutPropertySet<BR> pOutWorkspaceName.WorkspaceFactoryProgID = "esriDataSourcesGDB.AccessWorkspaceFactory.1"<BR> <BR> '设置输出要素的FeatureClass Name<BR> Dim pOutFCName As IFeatureClassName<BR> Set pOutFCName = New FeatureClassName<BR> Dim pDatasetName As IDatasetName<BR> Set pDatasetName = pOutFCName<BR> Set pDatasetName.WorkspaceName = pOutWorkspaceName<BR> <BR> pDatasetName.name = pOutNameCol.Item(i)<BR> <BR> '获得输入要素的FeatureClass Name<BR> Dim pInDatasetName As IDatasetName<BR> Set pInDatasetName = pInDatasetNameCol.Item(i)<BR><BR> '判断是否有重名现象<BR> Dim pWS2 As IWorkspace2<BR> Set pWS2 = pWS<BR> <BR> '如果名称已存在<BR> If pWS2.NameExists(esriDTFeatureClass, pDatasetName.name) Then<BR> Dim R<BR> R = MsgBox("矢量要素" ; pDatasetName.name ; "在数据库中已存在!" ; Chr(13) ; "是否覆盖?", vbExclamation + vbYesNo)<BR> '覆盖原矢量要素<BR> If R = vbYes Then<BR> Dim pFWS As IFeatureWorkspace<BR> Set pFWS = pWS<BR> Dim pDataset As IDataset<BR> Set pDataset = pFWS.OpenFeatureClass(pDatasetName.name)<BR> pDataset.Delete<BR> <BR> Set pFWS = Nothing<BR> Set pDataset = Nothing<BR> <BR> '不覆盖,则退出for循环,忽略这个要素,转入下一个要素的导入<BR> Else<BR> GoTo NextStep<BR> End If<BR> <BR> Set pWS2 = Nothing<BR> <BR> End If<BR> <BR> '打开Table获得Fields<BR> Dim pname As IName<BR> Dim pInTable As ITable<BR> Set pname = pInDatasetName<BR> Set pInTable = pname.Open<BR> <BR> Dim pInFields As IFields<BR> Set pInFields = pInTable.Fields<BR> <BR> '检查Field Name<BR> Dim pFieldChecker As IFieldChecker<BR> Set pFieldChecker = New FieldChecker<BR> Dim pOutFields As IFields<BR> pFieldChecker.Validate pInFields, Nothing, pOutFields<BR> <BR> '对Fields进行循环查,查找Geometry域<BR> Dim j As Integer<BR> Dim pGeoField As IField<BR> For j = 0 To pOutFields.FieldCount - 1<BR> If pOutFields.Field(j).Type = esriFieldTypeGeometry Then<BR> Set pGeoField = pOutFields.Field(j)<BR> Exit For<BR> End If<BR> Next j<BR> <BR> '获得Geometry Field的GeometryDef<BR> Dim pOutFCGeoDef As IGeometryDef<BR> Set pOutFCGeoDef = pGeoField.GeometryDef<BR> <BR> '设置GeometryDef的GridCount,GridSize,SpatialReference<BR> Dim pOutFCGeoDefEdit As IGeometryDefEdit<BR> Set pOutFCGeoDefEdit = pOutFCGeoDef<BR> pOutFCGeoDefEdit.GridCount = 1<BR> pOutFCGeoDefEdit.GridSize(0) = DefaultIndexGrid(pInTable)<BR> <BR> Dim re<BR> <BR> '判断空间参考是否一致,全局变量m_SpatialRef是创建的矢量要素集的空间参考<BR> If m_SpatialRef.name <> pGeoField.GeometryDef.SpatialReference.name Then<BR> re = MsgBox(pInDatasetName.name ; "的空间参考与数据库中的矢量要素集空间参考不符!" ; Chr(13) _<BR> ; "导入后会丢失数据。 是否继续导入?", vbYesNo + vbExclamation)<BR> Set pOutFCGeoDefEdit.SpatialReference = m_SpatialRef<BR> If re = vbNo Then<BR> GoTo NextStep<BR> End If<BR> Else<BR> Set pOutFCGeoDefEdit.SpatialReference = pGeoField.GeometryDef.SpatialReference<BR> End If<BR> '+++++++++++++++++++<BR> 'Set pOutFCGeoDefEdit.SpatialReference = pGeoField.GeometryDef.SpatialReference<BR> <BR> '进行导入<BR> Dim pConverter As IFeatureDataConverter<BR> Set pConverter = New FeatureDataConverter<BR> <BR> pConverter.ConvertFeatureClass pInDatasetNameCol.Item(i), Nothing, pOutFDSName, pOutFCName, pOutFCGeoDef, pOutFields, "", 1000, 0<BR> <BR> Set pOutPropertySet = Nothing<BR> Set pOutWorkspaceName = Nothing<BR> Set pOutFCName = Nothing<BR> Set pDatasetName = Nothing<BR> Set pInDatasetName = Nothing<BR> Set pname = Nothing<BR> Set pInTable = Nothing<BR> Set pFieldChecker = Nothing<BR> Set pOutFields = Nothing<BR> Set pGeoField = Nothing<BR> Set pOutFCGeoDef = Nothing<BR> Set pConverter = Nothing<BR> <BR> <BR>NextStep:<BR>Next i<BR>Set pWSF = Nothing<BR>Set pWS = Nothing<BR><BR>End Function
|
|
|
|
1楼#
发布于:2007-10-05 16:54
谢谢啊<img src="images/post/smile/dvbbs/em03.gif" /><img src="images/post/smile/dvbbs/em02.gif" />
|
|