YouTube | Facebook | Twitter  Feed

マップ スケールの設定

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.FocusMap
     
    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.MapScale = Right(ChangeScales.Item(newIndex), 6)
                 
            End If
            Set pElement = pGraphContainer.Next
        Wend
    End If
     
     
     
    pActiveView.Refresh
     
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ジャパン(株)所属、青山学院大学非常勤講師を兼務。発言は個人の見解です。

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