YouTube | Facebook | X(Twitter) | RSS

マップ スケールの設定

2016/9/1 (木)

'スケール変更
Private Sub ChangeScales_SelectionChange(ByVal newIndex As Long)
    Dim pMxDocument As IMxDocument
    Set pMxDocument = ThisDocument

    Dim pActiveView As IActiveView
    Set pActiveView = pMxDocument.ActiveView

    If TypeOf pActiveView Is IMap Then
        Dim pMap As IMap
        Set pMap = pActiveView
        pMap.MapScale = Right(ChangeScales.Item(newIndex), 6)

    ElseIf TypeOf pActiveView Is IPageLayout Then
        Dim pPageLayout As IPageLayout
        Set pPageLayout = pMxDocument.PageLayout

        Dim pGraphContainer As IGraphicsContainer
        Set pGraphContainer = pPageLayout

        pGraphContainer.Reset

        Dim pElement As IElement
        Set pElement = pGraphContainer.Next
        While Not pElement Is Nothing
            If TypeOf pElement Is IMapFrame Then
                Dim pMapFrame As IMapFrame
                Set pMapFrame = pElement

                pMapFrame.ExtentType = esriAutoExtentScale
                pMapFrame.MapScale = Right(ChangeScales.Item(newIndex), 6)

                pActiveView.Refresh
                pMapFrame.ExtentType = esriAutoExtentNone  // 再描画後に定数を変更

            End If
            Set pElement = pGraphContainer.Next
        Wend
    End If

End Sub

'MXDファイルを開く
Private Function MxDocument_NewDocument() As Boolean

    ChangeScales.RemoveAll

    ChangeScales.AddItem "1/   500"
    ChangeScales.AddItem "1/  1000"
    ChangeScales.AddItem "1/  2500"
    ChangeScales.AddItem "1/  5000"
    ChangeScales.AddItem "1/ 10000"
    ChangeScales.AddItem "1/ 12500"
    ChangeScales.AddItem "1/ 25000"
    ChangeScales.AddItem "1/ 50000"
    ChangeScales.AddItem "1/100000"
    ChangeScales.AddItem "1/200000"
End Function

Private Function MxDocument_OpenDocument() As Boolean

    ChangeScales.RemoveAll

    ChangeScales.AddItem "1/   500"
    ChangeScales.AddItem "1/  1000"
    ChangeScales.AddItem "1/  2500"
    ChangeScales.AddItem "1/  5000"
    ChangeScales.AddItem "1/ 10000"
    ChangeScales.AddItem "1/ 12500"
    ChangeScales.AddItem "1/ 25000"
    ChangeScales.AddItem "1/ 50000"
    ChangeScales.AddItem "1/100000"
    ChangeScales.AddItem "1/200000"

End Function

'相対パス設定
Private Sub SetRelativePaths_Click()

    Dim pMxDocument As IMxDocument
    Set pMxDocument = ThisDocument

    pMxDocument.RelativePaths = True

    MsgBox "相対パスに設定しました"

End Sub
  • この記事を書いた人

羽田 康祐

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

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