How to Open a Table, Convert it to ShapeFile & projecting the data using the X and Y

BELAYACHISara — Thu, 19 May 2011 14:13:25 GMT

Hi,
i need to create the same window as this one using VBA :

it's my first project using ArcObject, i create this interface :

i did programme the button "Parcourir" ( browse ) using a commonDialog, it get just the files "*.dbf"

Private Sub CmdPrc_Click()

On Error GoTo Annuler
With CommonDialog1
    .DialogTitle = "Choisissez une Table"
    .CancelError = True
    .Filter = "Tous (*.dbf)|*.dbf"
    .InitDir = "C:\"
    .ShowOpen
  Text1.Text = .fileName
   
Annuler:
If Text1.Text = "" Then
    Label1.Caption = "Vous n'avez sélectionné aucun fichier."
    Else
    Label1.Caption = ""
    End If
End With

End Sub

the combobox also works good, but they take there value manually, this is the code :

Private Sub UserForm_Initialize()
With CmboX
    .AddItem "OID"
    .AddItem "PT"
    .AddItem "PP"
    .AddItem "PI"
    .AddItem "BPLB"
    .AddItem "BPLL"
    .AddItem "RP"
    .AddItem "CO2B"
    .AddItem "CO2L"
    .AddItem "MGOB"
    .AddItem "MGOL"
    .AddItem "X"
    .AddItem "Y"
End With
With CmboY
    .AddItem "OID"
    .AddItem "PT"
    .AddItem "PP"
    .AddItem "PI"
    .AddItem "BPLB"
    .AddItem "BPLL"
    .AddItem "RP"
    .AddItem "CO2B"
    .AddItem "CO2L"
    .AddItem "MGOB"
    .AddItem "MGOL"
    .AddItem "X"
    .AddItem "Y"
End With

CmboX.ListIndex = 11
CmboY.ListIndex = 12
End Sub

now i'm sticked at "Ok" button, and Edit button i don't know how to fix it,

the Button "Ok" should :

- Open the Table "*.dbf" , then take the coordinate X and Y, and convert it to a shapefile , then open all the data with there (X, Y) in ArcMAP

the Button "Edit" should open that window to define a projection and a coordinate system :

that you can get it by adding a table -> click right -> Display XY Data -> click button "Edit"

i need to programme that, that's the point of my training end of study
I need help, please if anyone could help me.

Re: How to Open a Table, Convert it to ShapeFile & projecting the data using the X an

BELAYACHISara — Fri, 10 Dec 2021 22:36:41 GMT

i find the solution :

Button Parcourir :

Private Sub CmdPrc_Click()
Dim pGxDialog As IGxDialog
Dim pTabFilter As IGxObjectFilter
Dim pEnumGx As IEnumGxObject
Set pTabFilter = New GxFilterTables
Set pGxDialog = New GxDialog
Set pGxDialog.ObjectFilter = pTabFilter
pGxDialog.AllowMultiSelect = True
pGxDialog.RememberLocation = True
pGxDialog.Title = "Browse Data"
If Not pGxDialog.DoModalOpen(0, pEnumGx) Then
Exit Sub
        'Exit if user press Cancel
End If


' ---- Added Code ----
Dim pGxObj As IGxObject
Dim pName As IName
Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim pSATblColl As IStandaloneTableCollection
Dim pSATbl As IStandaloneTable

  Do
    ' Get the selected object
    Set pGxObj = pEnumGx.Next
    If pGxObj Is Nothing Then Exit Do
    Set pName = pGxObj.InternalObjectName

    ' Check it's a table
    If TypeOf pName Is ITableName Then
     
           If pGxObj.Category = "dBASE Table" Then
            ' Create a new standalone table using the selected table
           Set pSATbl = New StandaloneTable
           On Error GoTo error
           Set pSATbl.Table = pName.Open
        
          ' Add it to the map
           RemoveEverythingTOC
           RemoveStandAloneTables
           Set pMxDoc = ThisDocument
           Set pMap = pMxDoc.FocusMap
           Set pSATblColl = pMap
           pSATblColl.AddStandaloneTable pSATbl
        
           ' Update the TOC (tables appear under the Source tab)
           pMxDoc.UpdateContents
           populatetable
           Else
           MsgBox "Ce type de fichiers n'est pas supporter, veuillez choisir un fichier <*.dbf>"
           Exit Sub
            End If
    End If
        Text1.Text = pGxDialog.FinalLocation.FullName & "\" & CmboDbf.Text & ".dbf"
            few = 4
            nbr = Len(Text1.Text)
            pos = LastOccurence(Text1.Text, "\")
            L = nbr - (few + pos)
            D = nbr - (L + few)
            Name = Mid(Text1.Text, pos + 1, L)
            Dir = Mid(Text1.Text, 1, D)
        
Loop
Exit Sub
error:
 If Err.Number = -2147219886 Then
 MsgBox "Format Not Support"
 TextBox1.Text = ""
 CmboDbf.Clear
 CmboX.Clear
 CmboY.Clear
 Else
 MsgBox "Error occured adding the table. " & Err.Description & vbNewLine & _
 " Error Number: " & "(" & Err.Number & ")", _
 vbExclamation, "Error"
 TextBox1.Text = ""
 CmboDbf.Clear
 CmboX.Clear
 CmboY.Clear
 Exit Sub
 End If

  
'******************************************
'Procedure to add a dbf table to the map
'******************************************
    Dim pFact As IWorkspaceFactory
    Dim pWorkspace As IWorkspace
    Dim pFeatws As IFeatureWorkspace
    Dim pTable As ITable
    Set pFact = New ShapefileWorkspaceFactory
    Dim strOpenPath As String
    Dim strOpenTable As String
    Dim strTableNamewithPath As String
    strTableNamewithPath = Text1.Text 'Files path location
    Dim strRev As String
    strRev = StrReverse(strTableNamewithPath)
    strRev = Mid(strRev, 1, InStr(1, strRev, "\") - 1)
    strOpenTable = StrReverse(strRev)
    strOpenPath = Mid(strTableNamewithPath, 1, InStr(1, strTableNamewithPath, strOpenTable) - 1)
    Set pWorkspace = pFact.OpenFromFile(strOpenPath, 0)
    Set pFeatws = pWorkspace
    Set pTable = pFeatws.OpenTable(strOpenTable)
     'add the table
    Add_Table_TOC pTable

Sub populatetable()
'Loop through the standalone tables in a map
Dim pDoc As IMxDocument
Dim pMap As IMap
Dim pStandaloneTableCollection As IStandaloneTableCollection
Dim pStandaloneTable As IStandaloneTable
Dim pTable As ITable

'Get the current map from the document
Set pDoc = ThisDocument
Set pMap = pDoc.FocusMap
    
'Get the table collection from the map
 CmboDbf.Clear
 Dim i As Long
Set pStandaloneTableCollection = pMap
For i = 0 To pStandaloneTableCollection.StandaloneTableCount - 1
    Set pStandaloneTable = pStandaloneTableCollection.StandaloneTable(i)
    CmboDbf.AddItem pStandaloneTable.Name
Next
If CmboDbf.ListCount > 0 Then CmboDbf.ListIndex = 0
End Sub



Private Sub Add_Table_TOC(pTable As ITable)
'****************************************************************
'Procedure to add the table to Table of Contents of the Map.
'****************************************************************
    Dim pDoc As IMxDocument
    Dim pMap As IMap
    Dim intCol As Integer
    Dim blnExists As Boolean
    Dim pFeatws As IFeatureWorkspace
    Dim pWorkspace As IWorkspace
    Dim pFact As IWorkspaceFactory
    Set pDoc = ThisDocument
    Set pMap = pDoc.FocusMap
' Create a new standalone table and add it
' to the collection of the focus map
    Dim pStTab As IStandaloneTable
    Set pStTab = New StandaloneTable
    Set pStTab.Table = pTable
    Dim pStTabColl As IStandaloneTableCollection
    Set pStTabColl = pMap
    For intCol = 0 To pStTabColl.StandaloneTableCount - 1
        If pStTabColl.StandaloneTable(intCol).Name = pStTab.Name Then
            blnExists = True
            Exit For
        End If
    Next
    Dim i As Integer
      For i = 0 To pDoc.ContentsViewCount - 1
      If pDoc.ContentsView(i).Name = "Source" Then
      Set pDoc.CurrentContentsView = pDoc.ContentsView(i)
      Exit For
      End If
      Next i
    
    
    If blnExists = False Then
        pStTabColl.AddStandaloneTable pStTab
    End If
' Refresh the TOC
    pDoc.UpdateContents
    
    Set pDoc = Nothing
    Set pStTabColl = Nothing
    Set pMap = Nothing
    Set pStTabColl = Nothing
    Set pTable = Nothing
    Set pFeatws = Nothing
    Set pWorkspace = Nothing
    Set pFact = Nothing
End Sub

Button Editer :

Private Sub CmdEdt_Click() ' Set the Spatial Reference for Point1
'On Error GoTo et

Dim pDialog As ISpatialReferenceDialog
Set pDialog = New SpatialReferenceDialog
' Dim pSpatialReference As ISpatialReference a declarer au debut de la form public, pour l'affecter a (set pXYEventSourceName.SpatialReference = pSpatialReference)
Set pSpatialReference = pDialog.DoModalCreate(False, False, False, Form1.ActiveControl)
If pSpatialReference Is Nothing Then
 MsgBox "Veuillez choisir un System de projection !"
 ElseIf TextBox1.Text = "" Then
 MsgBox "Veuillez choisir un fichier <.dbf> "
 Exit Sub
 Else
   TextBox1.Text = "Projected Coordinate System_" & "Name:  " & pSpatialReference.Name
End If


'et:
'HandleError
End Sub

Button Ok :

Private Sub CmdOk_Click()
'On Error GoTo EH

  Dim pDoc As IMxDocument
  Dim pMap As IMap
  Set pDoc = ThisDocument
  Set pMap = pDoc.FocusMap
  
  ' Get the table named Table.dbf or txt...
  Dim pStTabCol As IStandaloneTableCollection
  Dim pStandaloneTable As IStandaloneTable
  Dim intCount As Integer
  Dim pTable As ITable
  Set pStTabCol = pMap
   For intCount = 0 To pStTabCol.StandaloneTableCount - 1
    Set pStandaloneTable = pStTabCol.StandaloneTable(intCount)
    
    If pStandaloneTable.Name = Name Then
      Set pTable = pStandaloneTable.Table
      Exit For
    End If
  Next intCount

     If pTable Is Nothing Then
    MsgBox "Veuillez ajouter une table"
    Exit Sub
  End If
  
 If CmboX.Text = "" Or CmboY.Text = "" Then
  MsgBox "Veuillez choisir les coordonnées XY !"
  Exit Sub
  End If
  
  If pSpatialReference Is Nothing Then
 MsgBox "Veuillez choisir un System de projection !"
 Exit Sub
 End If
  
  ' Get the table name object
  Dim pDataset As IDataset
  Dim pTableName As IName
  Set pDataset = pTable
  Set pTableName = pDataset.FullName
  
  ' Specify the X and Y fields
  Dim pXYEvent2FieldsProperties As IXYEvent2FieldsProperties
  Set pXYEvent2FieldsProperties = New XYEvent2FieldsProperties
  With pXYEvent2FieldsProperties
    .XFieldName = CmboX.Text
    .YFieldName = CmboY.Text
  End With

  ' Specify the projection
If pSpatialReference Is Nothing Then
 MsgBox "Veuillez choisir un System de projection !"
 Exit Sub
  Else
  ' Create the XY name object and set it's properties
  Dim pXYEventSourceName As IXYEventSourceName
  Dim pXYName As IName
  Dim pXYEventSource As IXYEventSource
  Set pXYEventSourceName = New XYEventSourceName
  With pXYEventSourceName
    Set .EventProperties = pXYEvent2FieldsProperties
    Set .SpatialReference = pSpatialReference
    Set .EventTableName = pTableName
  End With
  Set pXYName = pXYEventSourceName
  Set pXYEventSource = pXYName.Open
  End If
  
  
  ' Create a new Map Layer
  Dim pFLayer As IFeatureLayer
  Set pFLayer = New FeatureLayer
  Set pFLayer.FeatureClass = pXYEventSource
  pFLayer.Name = "Points Spacialisés"
  
  'Add the layer extension (this is done so that when you edit
  'the layer's Source properties and click the Set Data Source
  'button, the Add XY Events Dialog appears)
  Dim pLayerExt As ILayerExtensions
  Dim pRESPageExt As New XYDataSourcePageExtension
  Set pLayerExt = pFLayer
  pLayerExt.AddExtension pRESPageExt
  
  pMap.AddLayer pFLayer
  
  Exit Sub
  Unload Me
EH:
  HandleError
End Sub

topic How to Open a Table, Convert it to ShapeFile &amp; projecting the data using the X and Y in ArcObjects SDK Questions

How to Open a Table, Convert it to ShapeFile & projecting the data using the X and Y

Re: How to Open a Table, Convert it to ShapeFile & projecting the data using the X an

topic How to Open a Table, Convert it to ShapeFile & projecting the data using the X and Y in ArcObjects SDK Questions