Filling in atrributes for a point layer from a underlying polygon layer

[BretWhiteley1]

I am using the following script to grab parcel and address information from one layer to fill the attribute table of a newly created feature.

There is no returned error, but the problem I am having is that there seems to be the wrong information stuck in the memory of recordselect function.  No matter where I place a point it gives the same parcel # and address. Or maybe it isn???t actually be performing the IF function properly. 


Sub Address

                Dim rsCurrentXY
                Set rsCurrentXY = Map.Layers("Violations").records
                rsCurrentXY.movelast
                Dim objXYShape
                Set objXYShape = rsCurrentXY.Fields.Shape
                Dim pControls
                Set pControls= Application.Map.selectionlayer.Forms("EDITFORM").Pages(???PAGE1???).Controls
                Dim rsGrid          
                ' Find corresponding map page to the valve point
                Set rsGrid = Map.Layers("ACPA_parcels").records
                rsGrid.movefirst
               
                Do While Not rsGrid.eof
                                If rsGrid.fields.shape.Ispointin(objXYShape) Then
                                                pControls("txtAddress").value = rsGrid.Fields("ADD1").Value
                               
                                                Exit Do
                                End If
                                rsGrid.Movenext
                Loop     
               

                ' Clean Up
                Set rsCurrentXY = Nothing
                Set objXYShape = Nothing
                Set rsGrid = Nothing
End Sub


(I have another subroutine called "PIN" that would do the exact same thing.)
I have them called when their respective edit boxes in the custom form are activated by the inspector.

Thanks for the help,
Robert

[BretWhiteley1]

Sorry to hear that!  Did my attached example work for you?
If it's not a big deal, post your 2 features, apl files, and vbs in here.  I'll try to look into it for you.

I figured out the problem!~ but not the solution.

So when I click to create a feature, the correct attribute fill in the table, BUT if I click Cancel rather than Ok to accept the new feature (something that could happen in the field if the inspector clicks the wrong place), when I click a new location the old locations attributes are still stuck in the record select and the form waiting to be accepted.

So is there a way to code in "If the point doesn't get placed (the user clicks cancel) it clears all of the attributes stored"


PROGRESS!!


THANKS!

[ThaiTruong]

I figured out the problem!~ but not the solution.

So when I click to create a feature, the correct attribute fill in the table, BUT if I click Cancel rather than Ok to accept the new feature (something that could happen in the field if the inspector clicks the wrong place), when I click a new location the old locations attributes are still stuck in the record select and the form waiting to be accepted.

So is there a way to code in "If the point doesn't get placed (the user clicks cancel) it clears all of the attributes stored"


PROGRESS!!


THANKS!

Form:OnCancel Event will do...

[ThaiTruong]

Just a curiosity, did you toggle the "Repeat Attribute" button?!

However, I don't think it's matter because if you code it right, your address and pin values will be overwrited each time you place a new point!

[BretWhiteley1]

Just a curiosity, did you toggle the "Repeat Attribute" button?!

However, I don't think it's matter because if you code it right, your address and pin values will be overwrited each time you place a new point!

I don't know where that button is. So I'm going to assume no.  Also, there are still kinks in it. I'm going to upload a folder for you to play with. I can't get the OnCancelEvent script to work properly either.

Give me 5 minutes.

Again, thanks so much. You are the only one in all of cyberspace who is helping me.

[BretWhiteley1]

Just a curiosity, did you toggle the "Repeat Attribute" button?!

However, I don't think it's matter because if you code it right, your address and pin values will be overwrited each time you place a new point!

Attached is the .apx file with the code in it. You can make you your own polygon layer. The parcel layer is too large to send unless you have dropbox or something similar.

Thanks!

[ThaiTruong]

Attached is the .apx file with the code in it. You can make you your own polygon layer. The parcel layer is too large to send unless you have dropbox or something similar.

Thanks!

Your code above does not work for AXF files. You need to modify it and use DataSource object, then call Openlayer method to get the Recordset.  As of now, your code above only works with shapefiles.

If you can provide me a few records from ACPA_parcels and export those features out to a shapefile, I can help you with the coding tomorrow.
I need a parcel feature that has the same projection with your point file.

[BretWhiteley1]

Your code above does not work for AXF files. You need to modify it and use DataSource object, then call Openlayer method to get the Recordset.  As of now, your code above only works with shapefiles.

If you can provide me a few records from ACPA_parcels and export those features out to a shapefile, I can help you with the coding tomorrow.
I need a parcel feature that has the same projection with your point file.

Attached is a subset of parcels. Thanks so much for taking the time. 

I'll be in the office early tomorrow.

[ThaiTruong · Accepted solution]

Attached is a subset of parcels. Thanks so much for taking the time. 

I'll be in the office early tomorrow.

Because you have a large parcels dataset, using IsPointIn() will slow down your data capture process.  it has to loop through all the records inside your pacel layer to find one that contains the point.
So, in your case, I would use FindNearestXY() to find a parcel intersected with the collected point.  This will perform much better on a large datasets like your.

So, here is a new "InitilizeForm" sub for you.  Let me know if it works for you.

Sub InitilizeForm  Dim objLayer  'Get a reference to the first layer  Set objLayer = Application.Map.Layers("Violations")   Dim objEditForm  Set objEditForm = objLayer.forms("EDITFORM")   Dim pControls  Set pControls = ThisEvent.Object.Pages("PAGE1").Controls   Dim dblX, dblY  dblX = Map.PointerX    dblY = Map.PointerY   'Call when adding a new feature  If objEditForm.Mode = 3 Then   pControls("txtAddress").value = ""   pControls("txtPIN").value = ""    'Find Address & PIN # from Parcels Layer   Dim objParcels   Set objParcels = Application.Map.Layers("Parcels")   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("txtAddress").value = rsGrid.Fields("ADDR1").Value    pControls("txtPIN").value = rsGrid.Fields("PIN").Value   End If  End If   Set objLayer = Nothing  Set objEditForm = Nothing  Set pControls = Nothing  Set dblX = Nothing  Set dblY = Nothing  Set objParcels = Nothing  Set rsGrid = Nothing  Set Rec = Nothing End Sub

[BretWhiteley1]

Because you have a large parcels dataset, using IsPointIn() will slow down your data capture process.  it has to loop through all the records inside your pacel layer to find one that contains the point.
So, in your case, I would use FindNearestXY() to find a parcel intersected with the collected point.  This will perform much better on a large datasets like your.

So, here is a new "InitilizeForm" sub for you.  Let me know if it works for you.

Sub InitilizeForm
 Dim objLayer
 'Get a reference to the first layer
 Set objLayer = Application.Map.Layers("Violations")

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

 Dim pControls
 Set pControls = ThisEvent.Object.Pages("PAGE1").Controls

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

 'Call when adding a new feature
 If objEditForm.Mode = 3 Then
  pControls("txtAddress").value = ""
  pControls("txtPIN").value = ""

  'Find Address & PIN # from Parcels Layer
  Dim objParcels
  Set objParcels = Application.Map.Layers("Parcels")
  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("txtAddress").value = rsGrid.Fields("ADDR1").Value
   pControls("txtPIN").value = rsGrid.Fields("PIN").Value
  End If
 End If

 Set objLayer = Nothing
 Set objEditForm = Nothing
 Set pControls = Nothing
 Set dblX = Nothing
 Set dblY = Nothing
 Set objParcels = Nothing
 Set rsGrid = Nothing
 Set Rec = Nothing
End Sub

Brilliant! It works flawlessly.  Thank you so very much for your dedication to this community.

[ThaiTruong]

Brilliant! It works flawlessly.  Thank you so very much for your dedication to this community.

I'm glad that it works for you, and hope that you don't find my house to be in violation of irrigation codes! 🙂

BTW, here's an example on how IsPointIn() works:

Sub InitilizeForm
 Dim objLayer
 'Get a reference to the first layer
 Set objLayer = Application.Map.Layers("Violations")

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

 Dim pControls
 Set pControls = ThisEvent.Object.Pages("PAGE1").Controls

 Dim pPt
 Set pPt = Application.CreateAppObject("Point")

 pPt.X = Map.PointerX
 pPt.Y = Map.PointerY

 'Call when adding a new feature
 If objEditForm.Mode = 3 Then
  pControls("txtAddress").value = ""
  pControls("txtPIN").value = ""

  'Find Address & PIN # from Parcels Layer
  Dim objParcels
  Set objParcels = Application.Map.Layers("Parcels")
  Dim rsGrid
  Set rsGrid = objParcels.Records

  rsGrid.movefirst
  Do While Not rsGrid.eof
   If rsGrid.Fields.Shape.Ispointin(pPt) Then
    pControls("txtAddress").value = rsGrid.Fields("ADDR1").Value
    pControls("txtPIN").value = rsGrid.Fields("PIN").Value
    Exit Do
   End If
   rsGrid.Movenext
  Loop

 End If

 Set objLayer = Nothing
 Set objEditForm = Nothing
 Set pControls = Nothing
 Set pPt = Nothing
 Set objParcels = Nothing
 Set rsGrid = Nothing
End Sub