cl991036
管理员
管理员
  • 注册日期2003-07-25
  • 发帖数5917
  • QQ14265545
  • 铜币29669枚
  • 威望217点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • GIS帝国铁杆
阅读:1104回复:1

[转帖]常用数据入sde库的代码

楼主#
更多 发布于:2007-10-01 00:14
'****************************************************************<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
喜欢0 评分0
没钱又丑,农村户口。头可断,发型一定不能乱。 邮箱:gisempire@qq.com
whmwxhanshan123
路人甲
路人甲
  • 注册日期2006-06-17
  • 发帖数3108
  • QQ
  • 铜币6445枚
  • 威望0点
  • 贡献值0点
  • 银元0个
1楼#
发布于:2007-10-05 16:54
谢谢啊<img src="images/post/smile/dvbbs/em03.gif" /><img src="images/post/smile/dvbbs/em02.gif" />
举报 回复(0) 喜欢(0)     评分
游客

返回顶部