How to get field value from polygon feature in a point feature shapefile

[AndreaBressi]

Hi all,
I'm stuck with a problem about how to retrieve fields values from another polygon feature when adding new point feature that falls inside one polyg.
I use an apx file that include a button to start editing, an apa file that define a log-in username to fill-in the shapefile and the apl and vbs file that manage the shapefile form.
The problem is that I use a polygon grid file (with an ID that I want to transfer in a field of my target shapefile) that has many features and the target-shapefile vb script works fine on pc but it becomes extremely slow on the handheld (Trimble Juno SB). So I decided to transfer the part of script concerning the polyg grid in the apx file, and store the ID in a user property in order to call it from the target-shapefile vb script. But I don't know why it doesn't work! No errors came out when running on arcpad and so i can't understand where is the problem.
Many thanks for your help


This is my code:

APX vbs file:
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

Dim cella,n_cella

cella = Map.Layers("Grigliato_v2").records.FindNearestXY (dblX,dblY)
Map.Layers("Grigliato_v2").records.bookmark = cella
n_cella = Map.Layers("Grigliato_v2").records.Fields("N__CELLA").Value

Application.UserProperties("cella") = n_cella

End Sub

The target-shapefile vbs:
Option Explicit


Public Sub MyFormOnLoad

Dim pThisPageControls

Set pThisPageControls = EDITFORM.Pages("Page1").Controls
        pThisPageControls("edt_cella").Enabled = False 'disabilita l'edit nella textbox
pThisPageControls("edt_cella").Value = Application.UserProperties("cella")

set pThisPageControls = Nothing

end sub

[GarethWalters]

Hi Andrea,

I would suggest moving the MyFormOnLoad function to the Page OnSetActive Event. You are probably finding that the controls aren't avaiable when you are adding the values.

Let me know how you go.

Cheers,

Gareth

[AndreaBressi]

Thanks for the suggestion, by now I did it in another way.

My problem was the slowlyness in seeking for the id number using the Ispointin method, so I solved using the findnearestXY in the vbs shapefile script.

However I wanna try to solve the problem storing the id in a variable in the apx file and then pass it to the vbs shapefile script, if it's possible.

Here is the correct code:

Public Sub MyFormOnLoad
Dim objLayer
'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 = ""
  'pControls("txtPIN").value = ""

  'Find id from grid 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)
   pControls("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]

Well, I'm here again, now I would like to use the GPS fix in order to get the ID from the polygon layer.
I just added the same code lines but I changed from Map.pointerX e Y to Application.GPS.X e Y as you can see below.
The code is launched by two custom button in a toolbar. The first one (manual) onpointerup event, the second one (GPS) onclick event.
Just after opening the apm, I use the manual way and it load the ID from the underlying polygon feature, then if I use the GPS it reatain the old ID. And the same happens if I do the reverse, if I start from the GPS and then I pass to the manual acquisition it retains the ID. It seems that it can't clear the correct variable.
Someone of you could turn on a light over this problem?

Thanks again!

Dim objLayer
'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

Dim objLayerGPS
'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