PublicSub FCLoader()Sub FCLoader(pInPropertySet As IPropertySet, _ sInName AsString, _ pOutPropertySet As IPropertySet, _ sOutName AsString) ' 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 AsLong 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 =0To pOutFCFields.FieldCount If pOutFCFields.Field(i).Type = esriFieldTypeGeometry Then Set pGeoField = pOutFCFields.Field(i) ExitFor EndIf 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 IfNot pErrInfo IsNothingThen Debug.Print "Load completed with errors" Else Debug.Print "Load completed" EndIf Exit Sub ErrorRoutine: Debug.Print "Load Failed: Errors: "& Err.Number &""& Err.Description End Sub PrivateFunction DefaultIndexGrid()Function DefaultIndexGrid(InFC As IFeatureClass) AsDouble ' Calculate approximate first grid ' based on the average of a random sample of feature extents times five Dim lngNumFeat AsLong Dim lngSampleSize AsLong Dim pFields As IFields Dim pField As IField Dim strFIDName AsString Dim strWhereClause AsString Dim lngCurrFID AsLong Dim pFeat As IFeature Dim pFeatCursor As IFeatureCursor Dim pFeatEnv As IEnvelope Dim pQueryFilter As IQueryFilter Dim pNewCol AsNew Collection Dim lngKMax AsLong Dim dblMaxDelta AsDouble dblMaxDelta =0 Dim dblMinDelta AsDouble dblMinDelta =1000000000000# Dim dblSquareness AsDouble dblSquareness =1 Dim i AsLong Dim j AsLong Dim k AsLong 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 <=0Then DefaultIndexGrid =1000 Exit Function EndIf 'if the feature type is points use the density function If InFC.ShapeType = esriGeometryMultipoint Or InFC.ShapeType = esriGeometryPoint Then DefaultIndexGrid = DefaultIndexGridPoint(InFC) Exit Function EndIf ' Get the sample size lngSampleSize = lngNumFeat * SampleSize ' Don't allow too large a sample size to speed If lngSampleSize >1000Then 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 =1To lngNumFeat StepCLng(lngNumFeat / lngSampleSize) pNewCol.Add i Next i For j =0To pNewCol.Count -1Step250 ' Will we top out the features before the next 250 chunk? lngKMax = Min(pNewCol.Count - j, 250) strWhereClause = strFIDName +" IN(" For k =1To 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 WhileNot pFeat IsNothing ' 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 <>0Then dblSquareness = dblSquareness + ((Min(pFeatEnv.Width, pFeatEnv.Height) / (Max(pFeatEnv.Width, pFeatEnv.Height)))) Else dblSquareness = dblSquareness +0.0001 EndIf 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 EndIf End Function PrivateFunction Min()Function Min(v1 As Variant, v2 As Variant) As Variant Min =IIf(v1 < v2, v1, v2) End Function PrivateFunction Max()Function Max(v1 As Variant, v2 As Variant) As Variant Max =IIf(v1 > v2, v1, v2) End Function Function DefaultIndexGridPoint()Function DefaultIndexGridPoint(InFC As IFeatureClass) AsDouble ' Calculates the Index grid based on input feature class ' Get the dataset Dim pGeoDataSet As IGeoDataset Set pGeoDataSet = InFC ' Get the envelope of the input dataset Dim pEnvelope As IEnvelope Set pEnvelope = pGeoDataSet.Extent 'Calculate approximate first grid Dim lngNumFeat AsLong Dim dblArea AsDouble lngNumFeat = InFC.FeatureCount(Nothing) If lngNumFeat =0Or pEnvelope.IsEmpty Then ' when there are no features or an empty bnd - return 1000 DefaultIndexGridPoint =1000 Else dblArea = pEnvelope.Height * pEnvelope.Width ' approximate grid size is the square root of area over the number of features DefaultIndexGridPoint =Sqr(dblArea / lngNumFeat) EndIf Set pGeoDataSet =Nothing Set pEnvelope =Nothing End Function