アノテーション レイヤーに代替シンボルを追加する方法

      2017/12/09

Public Sub Test()
    '現在のドキュメントを取得
    Dim pMxDocument As IMxDocument
    Set pMxDocument = ThisDocument
     
    'アクティブなデータフレームの取得
    Dim pMap As IMap
    Set pMap = pMxDocument.FocusMap
     
    'レイヤを取得
    Dim pLayer As IFeatureLayer
    Set pLayer = pMap.Layer(0)
'    Set pLayer = pMap.Layer(InputBox("Layer Index ?"))
     
     
    Dim pSymbolSubstitution  As ISymbolSubstitution
    Set pSymbolSubstitution = pLayer
    pSymbolSubstitution.SubstituteType = esriSymbolSubstituteIndividualDominant
     
    Dim pSymbolCollection  As ISymbolCollection2
    Set pSymbolCollection = New SymbolCollection
'
'    pSymbolCollection.RemoveAll
     
    Dim pSymbolIdentifierNew As ISymbolIdentifier2
    Set pSymbolIdentifierNew = New SymbolIdentifier
'    Call pSymbolCollection.GetSymbolIdentifier(0, pSymbolIdentifier2)
     
    Dim pColor As IRgbColor
    Set pColor = New RgbColor
    pColor.RGB = vbYellow
     
    Dim pTextSymbol As ITextSymbol
    Set pTextSymbol = New TextSymbol
    pTextSymbol.size = 10
    pTextSymbol.Color = pColor
    pTextSymbol.Angle = 90
 
    Call pSymbolCollection.AddSymbol(pTextSymbol, "0", pSymbolIdentifierNew)
    Call pSymbolCollection.AddSymbol(pTextSymbol, "1", pSymbolIdentifierNew)
    Call pSymbolCollection.AddSymbol(pTextSymbol, "横", pSymbolIdentifierNew)   '該当のアノテーション クラスは「横」のシンボルID が2 この場合はダミーのシンボルを追加しないといけない
     
    Debug.Print pSymbolIdentifierNew.ID, pSymbolIdentifierNew.Name
     
    Call pSymbolCollection.Remove(0)    '不要なID分を削除
    Call pSymbolCollection.Remove(1)
     
    '追加したシンボルの確認
    Debug.Print "Count", pSymbolCollection.Count
    pSymbolCollection.Reset
     
    Dim pSymbolIdentifier As ISymbolIdentifier2
    Set pSymbolIdentifier = pSymbolCollection.Next
     
    Do Until pSymbolIdentifier Is Nothing
        Debug.Print "ID", pSymbolIdentifier.ID, pSymbolIdentifier.Name
        Set pSymbolIdentifier = pSymbolCollection.Next
    Loop
 
    Set pSymbolSubstitution.SubstituteSymbolCollection = pSymbolCollection
 
    pMxDocument.ActiveView.Refresh
 
End Sub

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