Sub exportfeatureclass()
Dim pfws As IFeatureWorkspace
Set pfws = OpenFeatureWorkspace
Dim prwse As IRasterWorkspaceEx
Set prwse = OpenSDEGeodatabase
Dim prc As IRasterCatalog
Set prc = prwse.OpenRasterCatalog("ORI002009002乌海")
ExportFootprint2 prc, pfws, "newfeatureclass"
End Sub
'open ifeatureworkspace
Function OpenFeatureWorkspace() As IFeatureWorkspace
Dim pwsf As IWorkspaceFactory
Set pwsf = New ShapefileWorkspaceFactory
Dim pws As IWorkspace
Set pws = pwsf.OpenFromFile("D:\tangdi", 0)
Dim pfws As IFeatureWorkspace
Set pfws = pws
Set OpenFeatureWorkspace = pfws
End Function
' Open an ArcSDE geodatabase
Function OpenSDEGeodatabase() As IRasterWorkspaceEx
Dim pConn As IPropertySet
Set pConn = New PropertySet
With pConn
.SetProperty "server", "zhyxkserver"
.SetProperty "instance", "5151"
.SetProperty "user", "prjzhyxksde"
.SetProperty "password", "prjzhyxksde"
.SetProperty "version", "sde.DEFAULT"
End With
Dim pFact As IWorkspaceFactory
Set pFact = New SdeWorkspaceFactory
Set OpenSDEGeodatabase = pFact.Open(pConn, 0)
End Function
Public Sub ExportFootprint2(pCatalog As IRasterCatalog, pOutWs As IFeatureWorkspace, sName As String)
' This procedure exports the footprint column of a raster catalog to a featureclass
Dim pFeatCls As IFeatureClass
Dim pFldsEdit As IFieldsEdit
Dim pFldEdit As IFieldEdit
Dim pOutFeatCls As IFeatureClass
Dim pCursor As IFeatureCursor
Dim pFeature As IFeature
Dim pRow As IRow
' QI IFeatureClass
Set pFeatCls = pCatalog
' Create fields with OID, NAME and SHAPE columns
Set pFldsEdit = New Fields
Set pFldEdit = New Field
pFldEdit.Name = "OBJECTID"
pFldEdit.Type = esriFieldTypeOID
pFldsEdit.AddField pFldEdit
Set pFldEdit = New Field
pFldEdit.Name = "NAME"
pFldEdit.Type = esriFieldTypeString
pFldsEdit.AddField pFldEdit
Set pFldEdit = New Field
pFldEdit.Name = "SHAPE"
pFldEdit.Type = esriFieldTypeGeometry
' Get shape fieldname and index from the rastercatalog
Dim sGeo As String
sGeo = pFeatCls.ShapeFieldName
Dim iShape As Integer
iShape = pFeatCls.FindField(sGeo)
' Set the geometrydef from the shape field in the raster catalog
Set pFldEdit.GeometryDef = pFeatCls.Fields.Field(iShape).GeometryDef
pFldsEdit.AddField pFldEdit
' Create output featureclass
Set pOutFeatCls = pOutWs.CreateFeatureClass(sName, pFldsEdit, Nothing, Nothing, esriFTSimple, "SHAPE", "")
' Get cursor from the raster catalog
Set pCursor = pFeatCls.Search(Nothing, False)
Set pFeature = pCursor.NextFeature
' Loop through all items and extract NAME and SHAPE column values
Do While Not pFeature Is Nothing
Set pRow = pOutFeatCls.CreateFeature
'NAME column
pRow.Value(2) = pFeature.Value(pCatalog.NameFieldIndex)
'SAHPE column
pRow.Value(1) = pFeature.Value(iShape)
pRow.Store
Set pFeature = pCursor.NextFeature
Loop
'Cleanup
Set pFeatCls = Nothing
Set pFldsEdit = Nothing
Set pFldEdit = Nothing
Set pOutFeatCls = Nothing
Set pCursor = Nothing
Set pFeature = Nothing
Set pRow = Nothing
End Sub
