Converts a featureClass to a new created Personal Geodatabase/Geodatabase featureClass.
該方法適用于簡單的要素類 (point, line, polygon)，不支持復雜的要素類(geometric network feature classes,
SDE 3.x annotation, Geodatabase annotation, coverage annotation)
Public Sub FCLoader(pInPropertySet As IPropertySet, _
sInName As String, _ pOutPropertySet As IPropertySet, _ sOutName As String) ' Setup output workspace. Dim pOutWorkspaceName As IWorkspaceName Set pOutWorkspaceName = New WorkspaceName pOutWorkspaceName.ConnectionProperties = pOutPropertySet pOutWorkspaceName.WorkspaceFactoryProgID = "esriDataSourcesGDB.SDEWorkspaceFactory.1" ' Set up for open. Dim pInWorkspaceName As IWorkspaceName Set pInWorkspaceName = New WorkspaceName pInWorkspaceName.ConnectionProperties = pInPropertySet pInWorkspaceName.WorkspaceFactoryProgID = "esriDataSourcesFile.ShapefileWorkspaceFactory.1" ' Set in dataset and table names. Dim pInFCName As IFeatureClassName Set pInFCName = New FeatureClassName Dim pInDatasetName As IDatasetName Set pInDatasetName = pInFCName pInDatasetName.Name = sInName Set pInDatasetName.WorkspaceName = pInWorkspaceName ' Set out dataset and table names. Dim pOutDatasetName As IDatasetName Dim pOutFCName As IFeatureClassName Set pOutFCName = New FeatureClassName Set pOutDatasetName = pOutFCName Set pOutDatasetName.WorkspaceName = pOutWorkspaceName pOutDatasetName.Name = sOutName ' Open input Featureclass to get field definitions. Dim pName As IName Dim pInFC As IFeatureClass Set pName = pInFCName Set pInFC = pName.Open ' Validate the field names. Dim pOutFCFields As IFields Dim pInFCFields As IFields Dim pFieldCheck As IFieldChecker Dim i As Long Set pInFCFields = pInFC.Fields Set pFieldCheck = New FieldChecker pFieldCheck.Validate pInFCFields, Nothing, pOutFCFields ' +++ Loop through the output fields to find the geometry field Dim pGeoField As IField For i = 0 To pOutFCFields.FieldCount If pOutFCFields.Field(i).Type = esriFieldTypeGeometry Then Set pGeoField = pOutFCFields.Field(i) Exit For End If Next i ' +++ Get the geometry field's geometry defenition Dim pOutFCGeoDef As IGeometryDef Set pOutFCGeoDef = pGeoField.GeometryDef ' +++ Give the geometry definition a spatial index grid count and grid size Dim pOutFCGeoDefEdit As IGeometryDefEdit Set pOutFCGeoDefEdit = pOutFCGeoDef pOutFCGeoDefEdit.GridCount = 1 pOutFCGeoDefEdit.GridSize(0) = DefaultIndexGrid(pInFC) Set pOutFCGeoDefEdit.SpatialReference = pGeoField.GeometryDef.SpatialReference Dim pQueryFilter As IQueryFilter Set pQueryFilter = New QueryFilter pQueryFilter.SubFields = "Shape,STATE_NAME" ' Load the table. Dim pFCToFC As IFeatureDataConverter Set pFCToFC = New FeatureDataConverter Dim pEnumErrors As IEnumInvalidObject Set pEnumErrors = pFCToFC.ConvertFeatureClass(pInFCName, pQueryFilter, Nothing, pOutFCName, pOutFCGeoDef, pOutFCFields, "", 1000, 0) ' If some of the records do not load, report to report window. Dim pErrInfo As IInvalidObjectInfo 'pEnumErrors.Reset Set pErrInfo = pEnumErrors.Next If Not pErrInfo Is Nothing Then Debug.Print "Load completed with errors" Else Debug.Print "Load completed" End If Exit SubErrorRoutine: Debug.Print "Load Failed: Errors: " & Err.Number & " " & Err.Description
End Sub
Private Function DefaultIndexGrid(InFC As IFeatureClass) As Double ' Calculate approximate first grid ' based on the average of a random sample of feature extents times five Dim lngNumFeat As Long Dim lngSampleSize As Long Dim pFields As IFields Dim pField As IField Dim strFIDName As String Dim strWhereClause As String Dim lngCurrFID As Long Dim pFeat As IFeature Dim pFeatCursor As IFeatureCursor Dim pFeatEnv As IEnvelope Dim pQueryFilter As IQueryFilter Dim pNewCol As New Collection Dim lngKMax As Long Dim dblMaxDelta As Double dblMaxDelta = 0 Dim dblMinDelta As Double dblMinDelta = 1000000000000# Dim dblSquareness As Double dblSquareness = 1 Dim i As Long Dim j As Long Dim k As Long Const SampleSize = 1 Const Factor = 1 ' Create a recordset Dim ColInfo(0), c0(3) c0(0) = "minext" c0(1) = CInt(5) c0(2) = CInt(-1) c0(3) = False ColInfo(0) = c0 lngNumFeat = InFC.FeatureCount(Nothing) - 1 If lngNumFeat <= 0 Then DefaultIndexGrid = 1000 Exit Function End If 'if the feature type is points use the density function If InFC.ShapeType = esriGeometryMultipoint Or InFC.ShapeType = esriGeometryPoint Then DefaultIndexGrid = DefaultIndexGridPoint(InFC) Exit Function End If ' Get the sample size lngSampleSize = lngNumFeat * SampleSize ' Don't allow too large a sample size to speed If lngSampleSize > 1000 Then lngSampleSize = 1000 ' Get the ObjectID Fieldname of the feature class Set pFields = InFC.Fields ' FID is always the first field Set pField = pFields.Field(0) strFIDName = pField.Name ' Add every nth feature to the collection of FIDs For i = 1 To lngNumFeat Step CLng(lngNumFeat / lngSampleSize) pNewCol.Add i Next i For j = 0 To pNewCol.Count - 1 Step 250 ' Will we top out the features before the next 250 chunk? lngKMax = Min(pNewCol.Count - j, 250) strWhereClause = strFIDName + " IN(" For k = 1 To lngKMax strWhereClause = strWhereClause + CStr(pNewCol.Item(j + k)) + "," Next k ' Remove last comma and add close parenthesis strWhereClause = Mid(strWhereClause, 1, Len(strWhereClause) - 1) + ")" Set pQueryFilter = New QueryFilter pQueryFilter.WhereClause = strWhereClause Set pFeatCursor = InFC.Search(pQueryFilter, True) Set pFeat = pFeatCursor.NextFeature While Not pFeat Is Nothing ' Get the extent of the current feature Set pFeatEnv = pFeat.Extent ' Find the min, max side of all extents. The "Squareness", a measure ' of how close the extent is to a square, is accumulated for later ' average calculation. dblMaxDelta = Max(dblMaxDelta, Max(pFeatEnv.Width, pFeatEnv.Height)) dblMinDelta = Min(dblMinDelta, Min(pFeatEnv.Width, pFeatEnv.Height)) ' lstSort.AddItem Max(pFeatEnv.Width, pFeatEnv.Height) If dblMinDelta <> 0 Then dblSquareness = dblSquareness + ((Min(pFeatEnv.Width, pFeatEnv.Height) / (Max(pFeatEnv.Width, pFeatEnv.Height)))) Else dblSquareness = dblSquareness + 0.0001 End If Set pFeat = pFeatCursor.NextFeature Wend Next j ' If the average envelope approximates a square set the grid size half ' way between the min and max sides. If the envelope is more rectangular, ' then set the grid size to half of the max. If ((dblSquareness / lngSampleSize) > 0.5) Then DefaultIndexGrid = (dblMinDelta + ((dblMaxDelta - dblMinDelta) / 2)) * Factor Else DefaultIndexGrid = (dblMaxDelta / 2) * Factor End IfEnd FunctionPrivate Function Min(v1 As Variant, v2 As Variant) As Variant Min = IIf(v1 < v2, v1, v2)End FunctionPrivate Function Max(v1 As Variant, v2 As Variant) As Variant Max = IIf(v1 > v2, v1, v2)End FunctionFunction DefaultIndexGridPoint(InFC As IFeatureClass) As Double