Best way to create table from selection VBA/ArcObject

DavidBirkigt — Sat, 05 Feb 2011 03:41:31 GMT

Hi,
I am looking for some advice on the best way to create a new non-spatial table from a selection.
Is it best to use the ICursor or ISelectionset interface, looping through each field/row, placing the value in a new ITable or is some other appraoch better? I am working in Arc 9.3 using VBA.

More information
-I have a non spatial table
-Based on user inputs my program executes an sql statement, selecting rows that meet a certain criteria
-I want to create a new table based on this selection

Thanks

Re: Best way to create table from selection VBA/ArcObject

maxsteinbrenner — Sun, 12 Dec 2021 04:40:55 GMT

not exactly what you need but you can probably modify it to make it work for you.
here is some code that selects featureas and exports the table selection to a text file...


Private Sub MakeHighwayDistrictBoundaryLists()

    'finds unique values from pData.Field value in Polygon Layer
    Dim pDoc As IMxDocument
    Set pDoc = ThisDocument
    Set pPointLayer = pDoc.FocusMap.Layer(0)
    Set pPolyLayer = pDoc.FocusMap.Layer(10)
       
    'Set Polygon Layer name for labelling output table
    strLName = pPolyLayer.Name
    
    strPolyVariable = "DISTRICT"
    
    MakeList
    
End Sub

Private Sub MakeList()

     Dim pDoc As IMxDocument
     Set pDoc = ThisDocument
     
     Dim pMap As IMap
     Set pMap = pDoc.FocusMap
    
     Dim pData As IDataStatistics
     Dim pCursor As ICursor
     Dim pEnumVar As IEnumVariantSimple
     Dim pTable As ITable
                                
     Set pTable = pPolyLayer
     Set pCursor = pTable.Search(Nothing, False)
     Set pData = New DataStatistics
     pData.Field = strPolyVariable
     Set pData.Cursor = pCursor
     Set pEnumVar = pData.UniqueValues
     Value = pEnumVar.Next
      Dim DiagCollection As New Collection
     Dim Inst
                     
     Do Until IsEmpty(Value)
     If Value = " " Then
     Value = pEnumVar.Next
     Else
       
         'Selects Polygon form pPolyLayer that match the variable Value
         Dim pSelectedPoly As IFeatureSelection
         Set pSelectedPoly = pPolyLayer 'QI
         
         Dim strQuery As String
         
         If strPolyVariable = "ZIPCODE" Or strPolyVariable = "SANAREA" Or strPolyVariable = "DISTRICT" Then
            strQuery = strPolyVariable & " = " & Value
         Else
            strQuery = strPolyVariable & " = " & "'" & Value & "'"
         End If
         
         'Set Polygon Layer field value labelling output table; getting rid of losts of stuff for outputting a valid fieldname every time
         strFName = Replace(Replace(Replace(Replace(Value, "Weekly Bag Service + ", ""), " ", "_"), ",", "_and"), "/", "_")
         
         Dim pFilter As IQueryFilter
         Set pFilter = New QueryFilter
    
         pFilter.WhereClause = strQuery
    
         pSelectedPoly.SelectFeatures pFilter, esriSelectionResultNew, False
         
         'select all features in pPointLayer that intersect the selected features in pPolyLayer (selected using pSelectedPoly)
         Dim pFCur As IFeatureCursor
         Set pFCur = pPointLayer.FeatureClass.Search(Nothing, False)
         Dim pFSel2 As IFeatureSelection
         Set pFSel2 = pPointLayer
          
         'get the selection set for layer 1 and the ids for the selected features
         
         Dim pSelectionSet As ISelectionSet
         Dim pFSel1 As IFeatureSelection
         Set pFSel1 = pPolyLayer
         Set pSelectionSet = pFSel1.SelectionSet
         
         Dim pEnumIDs As IEnumIDs
         Set pEnumIDs = pSelectionSet.IDs
         
         Dim pGeoCollection As IGeometryCollection
         Set pGeoCollection = New GeometryBag
         
         Dim i As Long
         
         For i = 1 To pSelectionSet.Count
           pGeoCollection.AddGeometry pPolyLayer.FeatureClass.GetFeature(pEnumIDs.Next).Shape
         Next i
         
         Dim pSpatialFilter As ISpatialFilter
         Set pSpatialFilter = New SpatialFilter
          
         With pSpatialFilter
             Set .Geometry = pGeoCollection
             .GeometryField = "Shape"
             .SpatialRel = esriSpatialRelContains
         End With
         
         pFSel2.SelectFeatures pSpatialFilter, esriSelectionResultNew, False
         
         Dim pSelectionSet2 As ISelectionSet
         Dim pFSelect2 As IFeatureSelection
         Set pFSelect2 = pPointLayer
         Set pSelectionSet2 = pFSelect2.SelectionSet
         
         If pSelectionSet2.Count > 0 Then
            ExportSelSetFeatureLayertoTable
         End If
    
     End If
     Value = pEnumVar.Next
     
     Loop

End Sub

Public Sub ExportSelSetFeatureLayertoTable()

    Dim pDoc As IMxDocument
    Dim pMap As IMap
    Set pDoc = ThisDocument
    Set pMap = pDoc.FocusMap
    
    ' Get the selected layer
    Dim pTable As ITable
    Dim pFLayer As IFeatureLayer
    Dim pSelItem As IUnknown
    Set pSelItem = pDoc.SelectedItem
    If pSelItem Is Nothing Then
      MsgBox "Please select a feature feature layer."
      Exit Sub
    ElseIf TypeOf pSelItem Is IFeatureLayer Then
      Set pFLayer = pSelItem
      Set pTable = pFLayer.FeatureClass
    Else
      MsgBox "Please select a feature feature layer."
      Exit Sub
    End If
    'Confirm layer to be used with user
    
    ' Get the dataset name for the input table
    Dim pDataset As IDataset
    Dim pDSName As IDatasetName
    Set pDataset = pTable
    Set pDSName = pDataset.FullName
    
    ' Get the output dataset name ready. In this
    ' case we are creating a text file in c:\temp
    Dim pWkSpFactory As IWorkspaceFactory
    Dim pWkSp As IWorkspace
    Dim pWkSpDS As IDataset
    Dim pWkSpName As IWorkspaceName
    Dim pOutDSName As IDatasetName
    Dim lblnValidFile As Boolean
    
    Dim strFileName As String, strFileLocation As String
    strFileName = strLName & strFName & ".txt"
            
    strFileLocation = "V:\temp\"
    Set pWkSpFactory = New TextFileWorkspaceFactory
    Set pWkSp = pWkSpFactory.OpenFromFile(strFileLocation, 0)
    Set pWkSpDS = pWkSp
    Set pWkSpName = pWkSpDS.FullName
    Set pOutDSName = New TableName
      pOutDSName.Name = strFileName
    Set pOutDSName.WorkspaceName = pWkSpName
      
    Dim pQueryFilter As IQueryFilter
    Set pQueryFilter = New QueryFilter
    Dim strField1 As String, strField2 As String, strField3 As String, strField4 As String, strField5 As String, strField6 As String, strField7 As String
    strField1 = "NAME"
    strField2 = "PHONE"
    strField3 = "ADDRESS"
    strField4 = "CITY"
    strField5 = "STATE"
    strField6 = "ZIP"
    strField7 = "COUNTY"
       'Checking table for required fields
      Dim colTableFields As New Collection
      colTableFields.Add strField1
      colTableFields.Add strField2
      colTableFields.Add strField3
      colTableFields.Add strField4
      colTableFields.Add strField5
      colTableFields.Add strField6
      colTableFields.Add strField7
      
      Dim strcolTableFields As Variant, chkFieldExists As Long, strProblemMessage As String
      For Each strcolTableFields In colTableFields
          chkFieldExists = pTable.FindField(strcolTableFields)
          If chkFieldExists = -1 Then
              strProblemMessage = strProblemMessage & "Missing field in " & pDataset.Name & ": " & strcolTableFields & vbCrLf
          End If
      Next
      If strProblemMessage <> "" Then
          MsgBox "Problem with fields. " & vbCrLf & strProblemMessage
          'End
    '        Stop
          Exit Sub
      End If
      Dim strSubFields As String
      
      'Once residential and commercial is implemented, strField7 should not be exported
      strSubFields = strField1 & ", " & strField2 & ", " & strField3 & ", " & strField4 & ", " & strField5 & ", " & strField6 & ", " & strField7
    pQueryFilter.SubFields = strSubFields
    
    
         Dim pFeatureSel As IFeatureSelection
         Set pFeatureSel = pFLayer
         Dim pSelSet As ISelectionSet2
         Set pSelSet = pFeatureSel.SelectionSet
    
    
    
    ' Export selected set of records to text file
    Dim pExpOp As IExportOperation
    Set pExpOp = New ExportOperation
    pExpOp.ExportTable pDSName, pQueryFilter, pSelSet, pOutDSName, Application.hWnd
      
    'Not required can comment out after debugging
    ' add the table to map
    Dim pName As IName
    Dim pNewTable
    Dim pStTab As IStandaloneTable
    Dim pStTabColl As IStandaloneTableCollection
    Set pName = pOutDSName
    Set pNewTable = pName.Open
    Set pStTab = New StandaloneTable
    Set pStTab.Table = pNewTable
    Set pStTabColl = pMap
    pStTabColl.AddStandaloneTable pStTab
    
    pDoc.UpdateContents
  
End Sub

Re: Best way to create table from selection VBA/ArcObject

DavidBirkigt — Wed, 09 Feb 2011 01:39:28 GMT

Thanks Max,

I ended up using a similar method to get the job done.

Re: Best way to create table from selection VBA/ArcObject

SteveFang — Wed, 09 Feb 2011 18:45:56 GMT

Not sure exactly what are the requirements but IFeatureDataConverter2 has a method, ConvertTable, that might do similar thing that you are describing without recreating the table and loading row by row. Another alternative you can look into.

Steve

topic Best way to create table from selection VBA/ArcObject in ArcObjects SDK Questions

Best way to create table from selection VBA/ArcObject

Re: Best way to create table from selection VBA/ArcObject

Re: Best way to create table from selection VBA/ArcObject

Re: Best way to create table from selection VBA/ArcObject