topic Re: Acquiring GPS points and fill fields from underlying layer in ArcPad Questions

Acquiring GPS points and fill fields from underlying layer

AndreaBressi — Mon, 17 Jun 2013 11:21:27 GMT

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

Re: Acquiring GPS points and fill fields from underlying layer

AndreaBressi — Tue, 18 Jun 2013 07:21:21 GMT

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