YouTube | Facebook | X(Twitter) | RSS

ジオメトリの一時的な描画

2016/9/1 (木)

'*********************************************************************
' 定義   :fncDisplayGeometry(pGeometry As IGeometry, Rgb As Long)
' 概要   :ジオメトリタイプに応じてジオメトリを一時描画
' 第1引数:IGeometry    描画対象のジオメトリ
' 第2引数:Long         描画色(VBAで色の定数及び値を指定)
' 戻り値 :なし
'*********************************************************************
Public Function fncDisplayGeometry(pGeometry As IGeometry, Rgb As Long)
     
    'RgbColorオブジェクトの作成
    Dim pRgbColor As IRgbColor
    Set pRgbColor = New RgbColor
    pRgbColor.Rgb = Rgb
     
    vbRed
     
    Dim pSymbol As ISymbol
     
    Select Case pGeometry.GeometryType
        Case esriGeometryPoint                              'Point
            Dim pSimpleMarkerSymbol As ISimpleMarkerSymbol
            Set pSimpleMarkerSymbol = New SimpleMarkerSymbol
            pSimpleMarkerSymbol.Color = pRgbColor
            pSimpleMarkerSymbol.Style = esriSMSCircle
            Set pSymbol = pSimpleMarkerSymbol
             
        Case esriGeometryMultipoint                              'MultiPoint
            Dim pMSimpleMarkerSymbol As ISimpleMarkerSymbol
            Set pMSimpleMarkerSymbol = New SimpleMarkerSymbol
            pMSimpleMarkerSymbol.Color = pRgbColor
            pMSimpleMarkerSymbol.Style = esriSMSCircle
            Set pSymbol = pMSimpleMarkerSymbol
             
        Case esriGeometryPolyline                           'Polyline
            Dim pSimpleLineSymbol As ISimpleLineSymbol
            Set pSimpleLineSymbol = New SimpleLineSymbol
            pSimpleLineSymbol.Color = pRgbColor
            pSimpleLineSymbol.Style = esriSLSSolid
            Set pSymbol = pSimpleLineSymbol
             
        Case esriGeometryPolygon                            'Polygon
            Dim pSimpleFillSymbol As ISimpleFillSymbol
            Set pSimpleFillSymbol = New SimpleFillSymbol
            pSimpleFillSymbol.Color = pRgbColor
            pSimpleFillSymbol.Style = esriSFSSolid
            Set pSymbol = pSimpleFillSymbol
             
    End Select
     
    'Applicationの取得
    Dim pMxApplication As IMxApplication
    Set pMxApplication = Application
     
    'AppDisplayの取得
    Dim pDisplay As IDisplay
    Set pDisplay = pMxApplication.Display
     
    With pDisplay
        .StartDrawing pDisplay.hDC, esriNoScreenCache '描画開始
        .SetSymbol pSymbol  'シンボルの設定
         
        'ジオメトリタイプに応じて描画
        Select Case pGeometry.GeometryType
            Case esriGeometryPoint
                .DrawPoint pGeometry
         
            Case esriGeometryMultipoint
                .DrawMultipoint pGeometry
                 
            Case esriGeometryPolyline
                .DrawPolyline pGeometry
             
            Case esriGeometryPolygon
                .DrawPolygon pGeometry
             
        End Select
 
       
        .FinishDrawing  '描画終了
         
    End With
 
 
End Function
  • この記事を書いた人

羽田 康祐

伊達と酔狂のGISエンジニア。GIS上級技術者、Esri認定インストラクター、CompTIA CTT+ Classroom Trainer、潜水士、PADIダイブマスター、四アマ。WordPress は 2.1 からのユーザーで歴だけは長い。 代表著書『"地図リテラシー入門―地図の正しい読み方・描き方がわかる』 GIS を使った自己紹介はこちら。ESRIジャパン(株)所属、元青山学院大学非常勤講師を兼務。日本地図学会第31期常任委員。発言は個人の見解です。

-プログラミング, ArcGIS
-,