FeatureBookmark の使用

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMillisecond As Long)
 
Sub AddBookmark()
Dim pDoc As IMxDocument
Dim pSelLyr As IFeatureLayer
Dim pMap As IMap
Dim pFSel As IFeatureSelection
Dim pFeat As IFeature
Dim pMapBookMarks As IMapBookmarks
Dim pFeatBookMark As IFeatureBookmark
 
'Gets the selected layer
Set pDoc = ThisDocument
Set pSelLyr = pDoc.SelectedLayer
If pSelLyr Is Nothing Then
  MsgBox "Select a Layer from the TOC"
  Exit Sub
End If
 
'Make sure only one feature is selected
Set pMap = pDoc.FocusMap
Set pFSel = pSelLyr
If Not pFSel.SelectionSet.Count = 1 Then
  MsgBox "Select One Feature"
  Exit Sub
End If
'get the selected feature
Set pFeat = pSelLyr.FeatureClass.GetFeature(pFSel.SelectionSet.IDs.Next)
 
'Create a bookmark for the feature
'use a value from the attribute table
'for the bookmark name
Set pMapBookMarks = pMap
Set pFeatBookMark = New FeatureBookmark
 
With pFeatBookMark
  .Name = pFeat.Value(pFeat.Fields.FindField("AREA"))
  .FeatureClass = pSelLyr.FeatureClass
  .FeatureId = pFeat.OID
End With
'Add the bookmark to the map
pMapBookMarks.AddBookmark pFeatBookMark
 
'Flash the bookmark
FlashFeature pFeat, pDoc
 
End Sub
 
 
 
Public Sub FlashFeature(pFeature As IFeature, pMxDoc As IMxDocument)
   
  ' Start Drawing on screen
  pMxDoc.ActiveView.ScreenDisplay.StartDrawing 0, esriNoScreenCache
   
  ' Switch functions based on Geomtry type
  Select Case pFeature.Shape.GeometryType
    Case esriGeometryPolyline
      FlashLine pMxDoc.ActiveView.ScreenDisplay, pFeature.Shape
    Case esriGeometryPolygon
      FlashPolygon pMxDoc.ActiveView.ScreenDisplay, pFeature.Shape
    Case esriGeometryPoint
      FlashPoint pMxDoc.ActiveView.ScreenDisplay, pFeature.Shape
  End Select
   
  ' Finish drawing on screen
  pMxDoc.ActiveView.ScreenDisplay.FinishDrawing
End Sub
 
 
 
 
Sub test()
 
Dim pSpatialBoolmark As ISpatialBookmark
Set pSpatialBoolmark = New FeatureBookmark
 
Dim pPushPin As IPushPin
Set pPushPin = pSpatialBoolmark
 
 
 
 
End Sub
 
Sub ttt()
     
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
 
'Get a reference to bookmarks
Dim pMapBookMarks As IMapBookmarks
Set pMapBookMarks = pMxDoc.FocusMap
Dim pEnumBookmarks As IEnumSpatialBookmark
Set pEnumBookmarks = pMapBookMarks.Bookmarks
 
Dim pSpatialBookmark As ISpatialBookmark
pEnumBookmarks.Reset
'get the first bookmark
Set pSpatialBookmark = pEnumBookmarks.Next
If pSpatialBookmark Is Nothing Then Exit Sub
 
'Dim pAOIBoolmark As IAOIBookmark
'Set pAOIBoolmark = pSpatialBookmark
 
Dim pFeatureBookmark As IFeatureBookmark
Set pFeatureBookmark = pSpatialBookmark
 
Dim pDisplay As IDisplay
Dim pMxApplication As IMxApplication
Set pMxApplication = Application
 
Set pDisplay = pMxApplication.Display
 
pFeatureBookmark.Flash pDisplay
 
'Dim pPushPin As IPushPin
'Set pPushPin = pSpatialBookmark 'qi
 
 
End Sub
 
 
Sub draw_pushbin()
Dim pPushPin As IPushPin
Dim ppoint As IPoint
Dim pDisplay As IDisplay
Dim papp As IMxApplication
Dim pMarkerSymbol As IMarkerSymbol
 
Set papp = Application
Set pDisplay = papp.Display
Set ppoint = New point
 
ppoint.PutCoords 2, 5
 
Set pMarkerSymbol = New SimpleMarkerSymbol
Set pPushPin.MarkerSymbol = pMarkerSymbol
Set pPushPin.Location = ppoint
pPushPin.Draw pDisplay
pPushPin.Flash pDisplay
End Sub
 
 
Private Sub FlashLine(pDisplay As IScreenDisplay, pGeometry As IGeometry)
  Dim pLineSymbol As ISimpleLineSymbol
  Dim pSymbol As ISymbol
  Dim pRGBColor As IRgbColor
   
  Set pLineSymbol = New SimpleLineSymbol
  pLineSymbol.Width = 4
   
  Set pRGBColor = New RgbColor
  pRGBColor.Green = 128
   
  Set pSymbol = pLineSymbol
  pSymbol.ROP2 = esriROPNotXOrPen
   
  pDisplay.SetSymbol pLineSymbol
  pDisplay.DrawPolyline pGeometry
  Sleep 300
  pDisplay.DrawPolyline pGeometry
End Sub
 
Private Sub FlashPolygon(pDisplay As IScreenDisplay, pGeometry As IGeometry)
  Dim pFillSymbol As ISimpleFillSymbol
  Dim pSymbol As ISymbol
  Dim pRGBColor As IRgbColor
   
  Set pFillSymbol = New SimpleFillSymbol
  pFillSymbol.Outline = Nothing
   
  Set pRGBColor = New RgbColor
  pRGBColor.Green = 128
   
  Set pSymbol = pFillSymbol
  pSymbol.ROP2 = esriROPNotXOrPen
   
  pDisplay.SetSymbol pFillSymbol
  pDisplay.DrawPolygon pGeometry
  Sleep 300
  pDisplay.DrawPolygon pGeometry
End Sub
 
 
Private Sub FlashPoint(pDisplay As IScreenDisplay, pGeometry As IGeometry)
  Dim pMarkerSymbol As ISimpleMarkerSymbol
  Dim pSymbol As ISymbol
  Dim pRGBColor As IRgbColor
   
  Set pMarkerSymbol = New SimpleMarkerSymbol
  pMarkerSymbol.Style = esriSMSCircle
   
  Set pRGBColor = New RgbColor
  pRGBColor.Green = 128
   
  Set pSymbol = pMarkerSymbol
  pSymbol.ROP2 = esriROPNotXOrPen
   
  pDisplay.SetSymbol pMarkerSymbol
  pDisplay.DrawPoint pGeometry
  Sleep 300
  pDisplay.DrawPoint pGeometry
End Sub