ラベルの表示

投稿日:2016/9/1 (木) 更新日:

Public Sub ShowLabel()
    Dim pMxDocument As IMxDocument
    Set pMxDocument = ThisDocument
     
    Dim pGeoFeatureLayer As IGeoFeatureLayer
    Set pGeoFeatureLayer = pMxDocument.FocusMap.Layer(0)
     
    Dim pAnnotateLayerPropertiesCollection  As IAnnotateLayerPropertiesCollection
    Set pAnnotateLayerPropertiesCollection = pGeoFeatureLayer.AnnotationProperties
    'pAnnotateLayerPropertiesCollection.Clear    'ラベル設定の初期化
     
    '新規LabelEngineLayerPropertiesオブジェクトの作成
    Dim pLabelEngineLayerProperties As ILabelEngineLayerProperties
    pAnnotateLayerPropertiesCollection.QueryItem 0, pLabelEngineLayerProperties
     
    ' ラベルに使用するフィールド名を設定
    pLabelEngineLayerProperties.Expression = "[Name]"
     
    '[配置プロパティ] → [重なり回避] タブ(全タイプのレイヤ)
    Dim pOverposterLayerProperties2  As IOverposterLayerProperties2
    Set pOverposterLayerProperties2 = pLabelEngineLayerProperties.BasicOverposterLayerProperties
     
    '[重なり回避] タブ → [ラベルの重複を許可]
    pOverposterLayerProperties2.TagUnplaced = False 'チェックする場合は False
     
    '[配置プロパティ] → [配置] タブ(全タイプのレイヤ)
    Dim pBasicOverposterLayerProperties4 As IBasicOverposterLayerProperties4
    Set pBasicOverposterLayerProperties4 = pLabelEngineLayerProperties.BasicOverposterLayerProperties
     
    '[配置] タブ(ライン レイヤ)
    Dim pLineLabelPosition As ILineLabelPosition
    Set pLineLabelPosition = pBasicOverposterLayerProperties4.LineLabelPosition
     
    '[配置] → 位置(ライン レイヤ)
    pLineLabelPosition.Above = True
    pLineLabelPosition.OnTop = True
    pLineLabelPosition.Below = True
     
    '変更したオブジェクトを再設定(値書き込みのため)
    pBasicOverposterLayerProperties4.LineLabelPosition = pLineLabelPosition
     
    '[このレイヤのラベルを表示]にチェックを設定
    pGeoFeatureLayer.DisplayAnnotation = True
     
     
    'ラベル クラスの追加
    Dim pClone As IClone
    Set pClone = pLabelEngineLayerProperties
     
    Dim pLabelEngineLayerProperties2 As ILabelEngineLayerProperties
    Set pLabelEngineLayerProperties2 = pClone.Clone '複製
     
    pLabelEngineLayerProperties2.Expression = "[KEN]"
     
    Dim pAnnotateLayerProperties2 As IAnnotateLayerProperties
    Set pAnnotateLayerProperties2 = pLabelEngineLayerProperties2
    pAnnotateLayerProperties2.WhereClause = """KEN"" = '北海道'"
     
    pLabelEngineLayerProperties2.Add pLabelEngineLayerProperties2
     
    '画面の再描画
    pMxDocument.ActiveView.Refresh
 
End Sub

関連記事

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

Copyright© WINGFIELD since1981 , 2018 All Rights Reserved.