IFeatureDataConverter.ConvertFeatureClass Method

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() 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 Sub
ErrorRoutine:
    Debug.Print "Load Failed: Errors: " & Err.Number & " " & Err.Description
End Sub

Private   Function DefaultIndexGrid() 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 If
End Function

Private   Function Min() Function Min(v1 As Variant, v2 As Variant) As Variant
  Min = IIf(v1 < v2, v1, v2)
End Function

Private   Function 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) As Double
  ' 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 As Long
  Dim dblArea As Double
  lngNumFeat = InFC.FeatureCount(Nothing)
  If lngNumFeat = 0 Or 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)
  End If
  Set pGeoDataSet = Nothing
  Set pEnvelope = Nothing
 End Function

 

转载于:https://www.cnblogs.com/iswszheng/archive/2009/03/18/1415426.html