|
Bookmarks allow you to quickly navigate to pre-defined geographic extent rectangles and can be extremely useful for data quality assessment when your data is located a cross a large area. This script was developed to create an Area of Interest (AOI) bookmark that can be accessed from the View menu in ArcMap. It was written specifically to create a bookmark for each state highway, each highway's multiple parts (where the route is broken into discontiguous parts), and each part's start and end point I used this against the SGID93.Transportation.UDOTRoutes_Calibrated_EP route layer but you could modify this to work with just about anything. To run, make sure the layer you want to generate the bookmarks from is at the top of the ArcMap Table of Contents (TOC). Paste the code and make modifications (sort field, buffer size for end points, the way the AOI name is generated, etc). Most of the length of this script is from handling multipart features differently...it could be greatly simplified as needed. Bookmarks will be added so they can be viewed from both the Bookmark manager and the View-->Bookmarks menu item. Here are the results (at right). Bookmark files can also be saved and loaded as .dat files through the ArcMap bookmark manager. (Bookmarks updated 8/4/09) Download the state route .dat bookmark file Download the state route .dat bookmark file (with endpoints and edit parts)
Public Sub AddSpatialBookMarks() Dim pMxDoc As IMxDocument Dim pMap As IMap Dim pActiveView As IActiveView Dim pAreaOfInterest As IAOIBookmark Dim pMapBookmarks As IMapBookmarks Dim pFLayer As IFeatureLayer Dim pFC As IFeatureClass Dim pTableSort As ITableSort Dim pFCursor As IFeatureCursor Dim pFeature As IFeature Dim pPolyline As IPolyline Dim pPolylinePart As IGeometry Dim pEnv As IEnvelope Dim pCurve As ICurve Dim pPoint As IPoint Dim pGC As IGeometryCollection Dim x As Long Set pMxDoc = Application.Document Set pMap = pMxDoc.FocusMap Set pActiveView = pMap Set pFLayer = pMap.Layer(0) Set pFC = pFLayer.FeatureClass 'sort features by field for alphanumeric ordering Set pTableSort = New TableSort With pTableSort Set .Table = pFC .Fields = "LABEL" .Ascending("LABEL") = True .Sort Nothing End With Set pFCursor = pTableSort.Rows Set pFeature = pFCursor.NextFeature 'outer loop, iterate through route features Do Until pFeature Is Nothing Set pPolyline = pFeature.ShapeCopy Set pGC = pPolyline 'for multipart features, create a bookmark for overall geometry If pGC.GeometryCount > 1 Then Set pAreaOfInterest = New AOIBookmark Set pAreaOfInterest.Location = pPolyline.Envelope pAreaOfInterest.Name = pFeature.value(pFC.FindField("LABEL")) & " " & "(all)" Set pMapBookmarks = pMap pMapBookmarks.AddBookmark pAreaOfInterest End If 'inner loop, iterate through parts For x = 0 To pGC.GeometryCount - 1 'create link for individual parts Set pPolylinePart = pGC.Geometry(x) Set pAreaOfInterest = New AOIBookmark Set pAreaOfInterest.Location = pPolylinePart.Envelope If pGC.GeometryCount = 1 Then pAreaOfInterest.Name = pFeature.value(pFC.FindField("LABEL")) & " " & "(all)" Else pAreaOfInterest.Name = " " & pFeature.value(pFC.FindField("LABEL")) & " " & "(part " & x & ")" End If Set pMapBookmarks = pMap pMapBookmarks.AddBookmark pAreaOfInterest 'create link for individual part start points Set pCurve = pPolylinePart Set pPoint = pCurve.FromPoint Set pEnv = New Envelope pEnv.PutCoords pPoint.x - 1000, pPoint.y - 1000, pPoint.x + 1000, pPoint.y + 1000 Set pAreaOfInterest = New AOIBookmark Set pAreaOfInterest.Location = pEnv If pGC.GeometryCount = 1 Then pAreaOfInterest.Name = " " & pFeature.value(pFC.FindField("LABEL")) & " " & "(start)" Else pAreaOfInterest.Name = " " & pFeature.value(pFC.FindField("LABEL")) & " " & "(start part " & x & ")" End If Set pMapBookmarks = pMap pMapBookmarks.AddBookmark pAreaOfInterest 'create link for individual part end points Set pPoint = pCurve.ToPoint Set pEnv = New Envelope pEnv.PutCoords pPoint.x - 1000, pPoint.y - 1000, pPoint.x + 1000, pPoint.y + 1000 Set pAreaOfInterest = New AOIBookmark Set pAreaOfInterest.Location = pEnv If pGC.GeometryCount = 1 Then pAreaOfInterest.Name = " " & pFeature.value(pFC.FindField("LABEL")) & " " & "(end)" Else pAreaOfInterest.Name = " " & pFeature.value(pFC.FindField("LABEL")) & " " & "(end part " & x & ")" End If Set pMapBookmarks = pMap pMapBookmarks.AddBookmark pAreaOfInterest Next x Set pFeature = pFCursor.NextFeature Loop End Sub |