Acquiring GPS points and fill fields from underlying layer

[AndreaBressi]

Hi all! I solved some troubles with this kind of problems, but I've one that's still here!!
I've to auto-fill a field collecting the value from a specific polygon layer, but while the manual procedure works fine the GPS does not.
I use a fake GPS to test the procedure, and when I click on the proper icon Arcpad cacthes the right coords but fills the field with a value picked up from an adiacent polygon, I don't understand where is the matter!
I'm not a skilled programmer at all, so be patient! Thanks!

Here the code I use:

Option Explicit

' autocomplete user name field
Public Sub MyFormOnLoad
Dim objFrmCtls
Set objFrmCtls = EDITFORM.Pages("Page1").Controls
'Set objFrmCtls = ThisEvent.Object
'Set objEFPageOneControls = objFrmCtls.Pages("Page1").Controls
'objFrmCtls("edt_UserName").Enabled = False
objFrmCtls("edt_UserName").Value = Application.UserProperties("LoggedInEmployee")

' autocomplete zone

Dim rsCurrentXY
Set rsCurrentXY = Map.Layers("trees").records 'indica il il nome dello script vbs  e il layer target
rsCurrentXY.movelast
Dim objXYShape
Set objXYShape = rsCurrentXY.Fields.Shape
Dim pControls
Set pControls = EDITFORM.Pages("Page1").Controls  'indica la pagina del form dove si trova il campo da compilare

Dim rsZona
Set rsZona = Map.Layers("ZoneSorveglianzaPNGP").records 'indica il layer poligono da cui prendere il valore
rsZona.movefirst
 
Do While Not rsZona.eof
  If rsZona.fields.shape.Ispointin(objXYShape) Then
     'pControls("tipo").Enabled = False 'disabilita l'edit nella textbox ma solo se il campo è compilato in automatico
     pControls("tipo").value = rsZona.Fields("NOME").Value ' tells which is the form page to complete and which is the interested layer
Exit Do
  End If
  rsZona.Movenext

Loop

' Clean Up
Set rsCurrentXY = Nothing
Set objXYShape = Nothing
Set rsZona = Nothing
Set pControls = Nothing

' nomi valli in automatico
Dim rsCurrentXY1
Set rsCurrentXY1 = Map.Layers("trees").records 'indica il nome dello script vbs  e il layer target
rsCurrentXY1.movelast
Dim objXYShape1
Set objXYShape1 = rsCurrentXY1.Fields.Shape
Dim pControls1
Set pControls1 = EDITFORM.Pages("Page1").Controls  'indica la pagina del form dove si trova il campo da compilare

Dim rsValle
  Set rsValle = Map.Layers("Valli_PNGP_wgs84").records 'indica il layer poligono da cui prendere il valore
rsValle.movefirst
 
Do While Not rsValle.eof
  If rsValle.fields.shape.Ispointin(objXYShape1) Then
     'pControls1("edt_valle").Enabled = False ''disabilita l'edit nella textbox ma solo se il campo è compilato in automatico
     pControls1("edt_valle").value = rsValle.Fields("VALLE").Value ' indica il controllo nella pagina del form da campilare e da quale campo del layer origine prendere il valore
Exit Do
  End If
  rsValle.Movenext

Loop

' Clean Up
Set rsCurrentXY1 = Nothing
Set objXYShape1 = Nothing
Set rsValle = Nothing
Set pControls1 = Nothing



'Sub AddGPSPoint

Dim objLayerGPS ' compila il campo griglia con inserimento via GPS
'Get a reference to the first layer
Set objLayerGPS = Application.Map.Layers("trees")

Dim objEditFormGPS
Set objEditFormGPS = objLayerGPS.forms("EDITFORM")

Dim pControls3
Set pControls3 = EDITFORM.Pages("Page1").Controls

Dim newX, newY
newX = Application.GPS.X
newY = Application.GPS.Y

'Call when adding a new feature
If objEditFormGPS.Mode = 3 Then
  pControls3("edt_cella").value = ""
 
  'Find N_cella from grigliato Layer
  Dim objParcelsGPS
  Set objParcelsGPS = Application.Map.Layers("Grigliato_v2.shp")
  Dim rsGridGPS
  Set rsGridGPS = objParcelsGPS.Records

  Dim RecGPS
  RecGPS = rsGridGPS.FindNearestXY(newX,newY,0,map.Extent)
  If RecGPS > 0 Then
   rsGridGPS.MoveFirst
   rsGridGPS.move(RecGPS -1)
   pControls3("edt_cella").value = rsGridGPS.Fields("N__CELLA").Value
  End If
End If

Set objLayerGPS = Nothing
Set objEditFormGPS = Nothing
Set pControls3 = Nothing
Set newX = Nothing
Set newY = Nothing
Set objParcelsGPS = Nothing
Set rsGridGPS = Nothing
Set RecGPS = Nothing

'End sub

'Sub inserimento_manuale

Dim objLayer 'compila il campo griglia in automatico con inserimento manuale
'Get a reference to the first layer
Set objLayer = Application.Map.Layers("trees")

Dim objEditForm
Set objEditForm = objLayer.forms("EDITFORM")

Dim pControls2
Set pControls2 = EDITFORM.Pages("Page1").Controls

Dim dblX, dblY
dblX = Map.PointerX
   dblY = Map.PointerY

'Call when adding a new feature
If objEditForm.Mode = 3 Then
  pControls2("edt_cella").value = ""


  'Find N_cella from grigliato Layer
  Dim objParcels
  Set objParcels = Application.Map.Layers("Grigliato_v2.shp")
  Dim rsGrid
  Set rsGrid = objParcels.Records

  Dim Rec
  Rec = rsGrid.FindNearestXY(dblX,dblY,0,map.Extent)
  If Rec > 0 Then
   rsGrid.MoveFirst
   rsGrid.move(Rec -1)
   pControls2("edt_cella").value = rsGrid.Fields("N__CELLA").Value

  End If
End If

Set objLayer = Nothing
Set objEditForm = Nothing
Set pControls2 = Nothing
Set dblX = Nothing
Set dblY = Nothing
Set objParcels = Nothing
Set rsGrid = Nothing
Set Rec = Nothing

End sub

[AndreaBressi]

I (partially) solved my problems: the script now works because I created an apx which calls the GPS add-point function from the associated vbs. When the form loads the shape's vbs auto-fills correctly all the fields.
Now I have a last trouble because after the form closes clicking on "ok" arcpad returns a "run time error", it tells me that there's an undefined variable, source text unavailable. The problems is at the Dim rsGrid line of the trees.vbs file.
Thanks!
This is the finally working codes:

arcpad.vbs
Option Explicit

Sub AddTree
   Dim dblX, dblY, objToolButton, blnLyrExists
   'Get a reference to the tool button object.
   Set objToolButton = ThisEvent.Object
   'Initialize blnLyrExists flag to False.
   blnLyrExists = False
   'If Trees layer exists,
   'set the blnLyrExists flag to true.
   Dim objLyr
   For Each objLyr in Map.Layers
If StrComp (objLyr.Name, "Trees", 1) = 0 Then
       blnLyrExists = True
       Exit For
     End If
   Next
   'If Trees layer does not exist,
   'notify the user, return the tool button to its original state, and exit.
   If Not blnLyrExists Then
MsgBox "The Trees layer is not present in the current map.", vbExclamation, "Layer not present"
     objToolButton.Click
     Exit Sub
   End If
   'If the Trees layer does exist,
   'get the coordinates of the map where the user clicked.
   dblX = Map.PointerX
   dblY = Map.PointerY

   'Get a reference to the Trees layer object.
   Dim objLayer
Set objLayer = Map.Layers("Trees")
   'If the layer can be made editable, make it editable.
   If objLayer.CanEdit Then
     objLayer.Editable = True
     'Add a new tree (point feature) at the clicked location.
     Call Map.AddFeatureXY(dblX,dblY)
    
     'Return the tool button to its original state.
     objToolButton.Click
   End If
End Sub

Sub NewPoint

Dim newX, newY

If Application.GPS.IsValidFix = False Then
  MsgBox("No GPS fix! Assicurati che il GPS sia acceso e il segnale sia valido.")
  Exit Sub
End If

newX = Application.GPS.X
newY = Application.GPS.Y

If Not Application.Map.Layers("Trees").CanEdit Then
  Msgbox "Trees cannot be edited.",vbExclamation,"Error"   
  Exit Sub
End If

'If the layer is not already editable, make it editable
If Not Application.Map.Layers("Trees").Editable Then
  Application.Map.Layers("Trees").Editable = True
End If

'Attempt to add a new point to the currently editable point layer at the current GPS location
'Return an error message if the attempt fails
If Not Application.Map.AddFeatureXY(newX, newY) Then
  MsgBox "Error adding GPS Point.",vbExclamation,"Error"
  Exit Sub
End If

End Sub

trees.vbs
Option Explicit

' compila il campo dell'operatore in automatico
Public Sub MyFormOnLoad
Dim objFrmCtls
Set objFrmCtls = EDITFORM.Pages("Page1").Controls
'Set objFrmCtls = ThisEvent.Object
'Set objEFPageOneControls = objFrmCtls.Pages("Page1").Controls
'objFrmCtls("edt_UserName").Enabled = False
objFrmCtls("edt_UserName").Value = Application.UserProperties("LoggedInEmployee")

'compila il nome zona sorveglianza in automatico

Dim rsCurrentXY
Set rsCurrentXY = Map.Layers("trees").records 'indica il il nome dello script vbs  e il layer target
rsCurrentXY.movelast
Dim objXYShape
Set objXYShape = rsCurrentXY.Fields.Shape
Dim pControls
Set pControls = EDITFORM.Pages("Page1").Controls  'indica la pagina del form dove si trova il campo da compilare

Dim rsZona
Set rsZona = Map.Layers("ZoneSorveglianzaPNGP").records 'indica il layer poligono da cui prendere il valore
rsZona.movefirst
 
Do While Not rsZona.eof
  If rsZona.fields.shape.Ispointin(objXYShape) Then
     'pControls("tipo").Enabled = False 'disabilita l'edit nella textbox ma solo se il campo è compilato in automatico
     pControls("tipo").value = rsZona.Fields("NOME").Value ' indica il controllo nella pagina del form da campilare e da quale campo del layer origine prendere il valore
Exit Do
  End If
  rsZona.Movenext

Loop

' Clean Up
Set rsCurrentXY = Nothing
Set objXYShape = Nothing
Set rsZona = Nothing
Set pControls = Nothing

' nomi valli in automatico
Dim rsCurrentXY1
Set rsCurrentXY1 = Map.Layers("trees").records 'indica il nome dello script vbs  e il layer target
rsCurrentXY1.movelast
Dim objXYShape1
Set objXYShape1 = rsCurrentXY1.Fields.Shape
Dim pControls1
Set pControls1 = EDITFORM.Pages("Page1").Controls  'indica la pagina del form dove si trova il campo da compilare

Dim rsValle
  Set rsValle = Map.Layers("Valli_PNGP_wgs84").records 'indica il layer poligono da cui prendere il valore
rsValle.movefirst
 
Do While Not rsValle.eof
  If rsValle.fields.shape.Ispointin(objXYShape1) Then
     'pControls1("edt_valle").Enabled = False ''disabilita l'edit nella textbox ma solo se il campo è compilato in automatico
     pControls1("edt_valle").value = rsValle.Fields("VALLE").Value ' indica il controllo nella pagina del form da campilare e da quale campo del layer origine prendere il valore
Exit Do
  End If
  rsValle.Movenext

Loop

' Clean Up
Set rsCurrentXY1 = Nothing
Set objXYShape1 = Nothing
Set rsValle = Nothing
Set pControls1 = Nothing

'nomi griglia in automatico

Dim rsCurrentXY2
Set rsCurrentXY2 = Map.Layers("trees").records 'indica il nome dello script vbs  e il layer target
rsCurrentXY2.movelast
Dim objXYShape2
Set objXYShape2 = rsCurrentXY2.Fields.Shape
Dim pControls2
Set pControls2 = EDITFORM.Pages("Page1").Controls  'indica la pagina del form dove si trova il campo da compilare

Dim rsGrid
  Set rsGrid = Map.Layers("Grigliato_v2").records 'indica il layer poligono da cui prendere il valore
rsGrid.movefirst
 
Do While Not rsGrid.eof
  If rsGrid.fields.shape.Ispointin(objXYShape2) Then
     'pControls1("edt_valle").Enabled = False ''disabilita l'edit nella textbox ma solo se il campo è compilato in automatico
     pControls2("edt_cella").value = rsGrid.Fields("N__CELLA").Value ' indica il controllo nella pagina del form da campilare e da quale campo del layer origine prendere il valore
Exit Do
  End If
  rsGrid.Movenext

Loop

' Clean Up
Set rsCurrentXY2 = Nothing
Set objXYShape2 = Nothing
Set rsGrid = Nothing
Set pControls2 = Nothing

End Sub