YouTube | Facebook | Twitter  Feed

FeatureBookmark の使用

2016/9/1 (木)

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
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
'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


  • この記事を書いた人

羽田 康祐

Esri認定インストラクター、GIS上級技術者、測量士補、潜水士。GISy / GISc とその関連分野である地理学・地図学について日々の出来事で学んだ記憶を記録するためにブログを書いています。行動原理は伊達と酔狂。好きな地形は圏谷。好きな地図投影法はパースクインカンシャル図法とマクブライドトーマス四次平極図法。広島県呉市生まれ広島市出身。GIS を使った自己紹介はこちら

-プログラミング, ArcGIS

© 2021 WINGFIELD since1981