Home arrow GIS Data & Resources arrow Scripts and Code arrow Visual Basic / VBA arrow VBA: Create ArcMap Bookmarks From Features
VBA: Create ArcMap Bookmarks From Features PDF Print E-mail

Written by Bert Granberg,

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 Screenshot from ArcMap showing bookmarkscross 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


Users' Comments  
 

No comment posted

Add your comment

28, Jul. 2009
Last Updated ( 04, Aug. 2009 )
 
< Prev   Next >

AGRC Contacts | UGIC Contacts

feed image feed image

Utah GIS Portal © 2009 AGRC

Optimized for