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