Help with ArcObjects for VBA Application

738
2
Jump to solution
08-16-2013 12:41 PM
DavidDenham
Occasional Contributor
I have inherited a VBA application that we use to notify land owners of changes in zoning near their properties.  I did not write the original application and I have not done much programming in VBA.  I am currently working on replacing this application with a python add-in, but a change in state law is forcing me to update the VBA application because of time constraints.  The new state law requires that with any zoning cases municipalities must notify school districts of any changes in zoning that occur within the district boundaries.  I have create a polygon feature class of the school districts with the mailing addresses for each district.  Users can choose to select one or more parcels or zoning case polygons or choose to select a polygon shapefile to designate the area being rezoned.  The application then converts these polygons to a graphic element and then creates a graphical buffer around first graphic.  These graphics are then use select the parcels that intersect the combined graphics, select the corresponding records in a related tax roll table and export the results into a dbf file.  I want to use a spatial filter to select any school district polygons that intersect the shapefile polygons or the original selection before the graphics are created.  Then store the selected records in a global selectionset and insert the records into the final dbf.  I have tried to create a procedure to do this, but it keeps crashing on me.  Here is what I have so far:
Public Sub SelectSchoolDistrict()  Dim pMxApp As IMxApplication   Dim pMap As IMap   Dim pMxDoc As IMxDocument   Dim pActiveView As IActiveView   Dim pEnumFeature As IEnumFeature   Dim pFeature As IFeature   Set pMxApp = Application   Set pMxDoc = Application.Document   Set pActiveView = pMxDoc.FocusMap   Set pMap = pMxDoc.FocusMap        Dim pFeatureCursor As IFeatureCursor   Dim pFeatureSelection As IFeatureSelection   Dim pSelectionSet As ISelectionSet      Set pFeatureSelection = pMxDoc.FocusMap.Layer(1) 'FeatureSelection   Set pSelectionSet = pFeatureSelection.SelectionSet         m_SetSelectableLayer ("School District")      If ThisDocument.g_Model = 2 Then     Dim pISDLayer As IFeatureLayer     Dim pSearchLayer As ILayer              Dim ISDcount As Integer     For ISDcount = 0 To pMxDoc.FocusMap.LayerCount - 1         Set pSearchLayer = pMxDoc.FocusMap.Layer(ISDcount)         If pSearchLayer.Name = "School Districts" Then             Set pISDLayer = pSearchLayer             Exit For         End If     Next          Dim pISDfSel As IFeatureSelection     Set pISDfSel = pISDLayer          Dim pEnumParcelIDs As IEnumIDs     Set pEnumParcelIDs = pSelectionSet.IDs          Dim pGeoCollParcel As IGeometryCollection     Set pGeoCollParcel = New GeometryBag          Dim count As Long     For count = 1 To pSelectionSet.count         pGeoCollParcel.AddGeometry pISDLayer.FeatureClass.GetFeature(pEnumParcelIDs.Next).Shape     Next count          Dim pISDSpatialFilter As ISpatialFilter     Set pISDSpatialFilter = New SpatialFilter          With pISDSpatialFilter         Set .Geometry = pGeoCollParcel         .GeometryField = "Shape"         .SpatialRel = esriSpatialRelContains     End With          pISDfSel.SelectFeatures pISDSpatialFilter, esriSelectionResultNew, False          Set gISDSelectionSet = pISDfSel.SelectionSet                       End If    'End Section to add ISD addresses    End Sub  

I would appreciate any help or advise that anyone can offer.
0 Kudos
1 Solution

Accepted Solutions
DuncanHornby
MVP Notable Contributor
OK had a look at your code and you were getting the enumerate from the wrong layer. But I found reading your code a bit out of sync so whilst trying to understand I re-jigged and simplified so its easier. Also put some comments in!

I had to fake some data to make it work (selected points selecting polygons) and I use different layer names and positions so this code does not replace your existing code. You need to look at this and see the key changes to understand where you were going wrong.

Public Sub SelectSchoolDistrict()         Dim pMxApp As IMxApplication     Dim pMap As IMap     Dim pMxDoc As IMxDocument     Dim pActiveView As IActiveView     Dim pEnumFeature As IEnumFeature     Dim pFeature As IFeature     Set pMxApp = Application     Set pMxDoc = Application.Document     Set pActiveView = pMxDoc.FocusMap     Set pMap = pMxDoc.FocusMap          ' Get first layer and the selected ID's     Dim pFeatureCursor As IFeatureCursor     Dim pFeatureSelection As IFeatureSelection     Dim pSelectionSet As ISelectionSet     Dim pFeatureLayer As IFeatureLayer     Set pFeatureLayer = pMxDoc.FocusMap.Layer(0) ' A point layer     Set pFeatureSelection = pFeatureLayer     Set pSelectionSet = pFeatureSelection.SelectionSet     Dim pEnumParcelIDs As IEnumIDs     Set pEnumParcelIDs = pSelectionSet.IDs          ' Load selected points into  geometry bag     Dim pGeoColl As IGeometryCollection     Set pGeoColl = New GeometryBag     Dim pPoint As IPoint     Dim id As Long     id = pEnumParcelIDs.Next     Do While id <> -1         Set pFeature = pFeatureLayer.FeatureClass.GetFeature(id)         Set pPoint = pFeature.Shape         pGeoColl.AddGeometry pPoint         id = pEnumParcelIDs.Next     Loop     Dim pGeom As IGeometry     Set pGeom = pGeoColl          ' Get layer     Dim pISDLayer As IFeatureLayer     Dim ISDcount As Integer     For ISDcount = 0 To pMap.LayerCount - 1         Set pISDLayer = pMap.Layer(ISDcount)         If pISDLayer.Name = "Display Index" Then  ' A polygon layer         Exit For     End If     Next     Dim pISDfSel As IFeatureSelection     Set pISDfSel = pISDLayer       ' Create spatial filter     Dim pSpatialFilter As ISpatialFilter     Set pSpatialFilter = New SpatialFilter     With pSpatialFilter         Set .Geometry = pGeom         .GeometryField = "SHAPE"         .SpatialRel = esriSpatialRelWithin     End With          ' Do selection and refresh map     pISDfSel.SelectFeatures pSpatialFilter, esriSelectionResultNew, False     pActiveView.Refresh End Sub

View solution in original post

0 Kudos
2 Replies
DuncanHornby
MVP Notable Contributor
OK had a look at your code and you were getting the enumerate from the wrong layer. But I found reading your code a bit out of sync so whilst trying to understand I re-jigged and simplified so its easier. Also put some comments in!

I had to fake some data to make it work (selected points selecting polygons) and I use different layer names and positions so this code does not replace your existing code. You need to look at this and see the key changes to understand where you were going wrong.

Public Sub SelectSchoolDistrict()         Dim pMxApp As IMxApplication     Dim pMap As IMap     Dim pMxDoc As IMxDocument     Dim pActiveView As IActiveView     Dim pEnumFeature As IEnumFeature     Dim pFeature As IFeature     Set pMxApp = Application     Set pMxDoc = Application.Document     Set pActiveView = pMxDoc.FocusMap     Set pMap = pMxDoc.FocusMap          ' Get first layer and the selected ID's     Dim pFeatureCursor As IFeatureCursor     Dim pFeatureSelection As IFeatureSelection     Dim pSelectionSet As ISelectionSet     Dim pFeatureLayer As IFeatureLayer     Set pFeatureLayer = pMxDoc.FocusMap.Layer(0) ' A point layer     Set pFeatureSelection = pFeatureLayer     Set pSelectionSet = pFeatureSelection.SelectionSet     Dim pEnumParcelIDs As IEnumIDs     Set pEnumParcelIDs = pSelectionSet.IDs          ' Load selected points into  geometry bag     Dim pGeoColl As IGeometryCollection     Set pGeoColl = New GeometryBag     Dim pPoint As IPoint     Dim id As Long     id = pEnumParcelIDs.Next     Do While id <> -1         Set pFeature = pFeatureLayer.FeatureClass.GetFeature(id)         Set pPoint = pFeature.Shape         pGeoColl.AddGeometry pPoint         id = pEnumParcelIDs.Next     Loop     Dim pGeom As IGeometry     Set pGeom = pGeoColl          ' Get layer     Dim pISDLayer As IFeatureLayer     Dim ISDcount As Integer     For ISDcount = 0 To pMap.LayerCount - 1         Set pISDLayer = pMap.Layer(ISDcount)         If pISDLayer.Name = "Display Index" Then  ' A polygon layer         Exit For     End If     Next     Dim pISDfSel As IFeatureSelection     Set pISDfSel = pISDLayer       ' Create spatial filter     Dim pSpatialFilter As ISpatialFilter     Set pSpatialFilter = New SpatialFilter     With pSpatialFilter         Set .Geometry = pGeom         .GeometryField = "SHAPE"         .SpatialRel = esriSpatialRelWithin     End With          ' Do selection and refresh map     pISDfSel.SelectFeatures pSpatialFilter, esriSelectionResultNew, False     pActiveView.Refresh End Sub
0 Kudos
DavidDenham
Occasional Contributor
That fixed it thanks for the help.
0 Kudos