VbScript per collegamento veloce da Esri ArcMap a Google Maps e Bing

Vogliamo visualizzare un punto di una mappa da Esri ArcMap sulle foto satellitari di Google Maps o Bing con un solo click ?
Lo script che vi presento viene incontro.

Operativamente si tratta di aggiungere un bottone personalizzato ad una barra degli strumenti e collegarlo ad uno script. Cliccando sul bottone sarà attivata la modalità di collegamento veloce: cliccando su un punto sulla mappa in ArcMap sarà aperta una finestra sul browser (si potrà prima scegliere se visualizzare Google Maps o Bing) alle coordinate desiderate.

Questo metodo e lo script sono una rivisitazione dello script disponibile "Link to Google Maps and Bing from MXD (Streetview and Bird's Eye supported)" sul portale Esri. 
Originariamente postato da Bert Granberg sul portale Utah GIS.


Lo script è adattato alla rappresentazione numerica italiana, ed al nuovo url utilizzato da Google Maps.
Si presuppone che il progetto MXD sia già nelle coordinate Wgs84, altrimenti occorrerebbe una conversione al volo, non prevista dallo script.

Fase 1. Incollare il codice nel VBA Editor

1. Dal menu di ArcMap aprire il VBA Editor [Tools --> Macros --> Visual Basic Editor]
2. Nella finestra del VBA Editor, espandere la vista normale o del progetto per inserire il codice.
   Nota: se vogliamo che il bottone sia attivo su tutti i progetti Mxd, il codice va inserito nella finestra Normale (Normal.mxt), altrimenti nella finestra del vostro Progetto (YourMXDName.mxd)
3. Incollare il codice riportato più avanti
4. Salvare il codice, chiudere il VBA Editor, Salvare il progetto Mxd

Fase 2. Creare e configurare un bottone personalizzato (custom ArcMap Tool)

1. Dal menu di ArcMap selezionare [Tools - > Customize]
2. Cliccare sulla linguetta [Commands]
3. Scegliere dal combobox [Save in] se il bottone da creare va salvato in [Normal.mxd] o  nel vostro Progetto (YourMXDName.mxd), coerentemente alla scelta fatta nella fase 1 al punto 2
4. Cliccare su [UIControls] nella lista [Categories]. Quindi cliccare su [New UIControl]
5. Dall''elenco radio button selezionare [UIToolControl] e quindi cliccate su [Create]
   
   
   
6. Il nome del nuovo tool comparirà nella lista [Commands]. Cliccare sul nome per rinominarlo in "Normal.GoogleMap_Link" or "Project.GoogleMap_Link" a seconda di dove è stato messo il codice nella fase 1.
7. Cliccare e trascinare il nome del tool dalla lista [Commands] verso una Barra degli strumenti di ArcMap o su un menu.
8. Personalizzare il bottone o la voce del menu agendo con il tasto destro del mouse.
9. Salvare il progetto e provare ad utilizzare il tool.
10. Eventualmente personalizzare la parte statica dell'url da aprire nel codice (alla sezione del Case webmapchoice) per le specifiche esigenze di avvio di Google Maps / Bing (ad esempio per cambiare lo zoom iniziale o avviare direttamente la Street View). Per Google Maps le diverse opzioni disponibili per l'url statico sono ritrovabili a questo link, mentre per Bing a questo link.

-----------------------------------------------------------------
'CODICE DA INCOLLARE NEL VBA EDITOR

Option Explicit

Const SW_SHOWMAXIMIZED = 3
Const SW_SHOWMINIMIZED = 2
Const SW_SHOWDEFAULT = 10
Const SW_SHOWMINNOACTIVE = 7
Const SW_SHOWNORMAL = 1

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hWnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Private Function OpenLocation(URL As String, WinState As Long) As Long

    'PURPOSE: Opens default browser to display URL

    'RETURNS: module handle to executed application or
    'Error Code ( < 32) if there is an error

    'can also be used to open any document associated with
    'an application on the system (e.g., passing the name
    'of a file with a .doc extension will open that file in Word)

    Dim lHWnd As Long
    Dim lAns As Long

    lAns = ShellExecute(lHWnd, "open", URL, vbNullString, _
    vbNullString, WinState)
   
    OpenLocation = lAns

    'ALTERNATIVE: if not interested in module handle or error
    'code change return value to boolean; then the above line
    'becomes:

    'OpenLocation = (lAns > 32)

End Function


Private Function GoogleMap_Link_Message() As String
    GoogleMap_Link_Message = "Link to Google or Bing Web Map"
End Function

Private Sub GoogleMap_Link_Mousedown(ByVal button As Long, ByVal shift _
            As Long, ByVal x As Long, ByVal y As Long)
    
    Dim pMxDoc As IMxDocument
    Dim pApp As IMxApplication
    Dim pMap As IMap
    Dim pPoint As IPoint
    Dim pSpatialReferenceFactory As ISpatialReferenceFactory
    Dim pSpatialReference As ISpatialReference
    
    Set pMxDoc = ThisDocument
    Set pMap = pMxDoc.FocusMap
    Set pApp = Application

    Set pSpatialReferenceFactory = New SpatialReferenceEnvironment
    Set pSpatialReference = pSpatialReferenceFactory. _
        CreateGeographicCoordinateSystem(esriSRGeoCS_WGS1984)
    
    ' convert mouse click to map units
    Set pPoint = pApp.Display.DisplayTransformation.ToMapPoint(x, y)
    Set pPoint.SpatialReference = pMap.SpatialReference
    If pPoint.SpatialReference.Name <> pSpatialReference.Name Then
        pPoint.Project pSpatialReference

    End If
 
    Dim URLstr As String
    Dim returnLong As Long
    Dim webmapchoice
    
    webmapchoice = MsgBox("Launch web map application?" & vbCrLf & vbCrLf _
    & "Open Map at: " & Round(pPoint.y, 6) & ", " & Round(pPoint.x, 6) & vbCrLf & vbCrLf _
    & "Click YES for GOOGLE Maps" & vbCrLf _
    & "Click NO  for BING Maps" & vbCrLf & vbCrLf _
    & "or CANCEL to exit.", vbYesNoCancel, "WEB RESOURCES")
     
    Select Case webmapchoice
     
        Case 6
            'GOOGLE MAP - HYBRID
            URLstr = "https://maps.google.com/maps?q=" _
                & Replace(Round(pPoint.y, 6), ",", ".") & "," _
                & Replace(Round(pPoint.x, 6), ",", ".") _
                & "&z=17&t=h"

        Case 7
            'BING MAPS - HYBRID
            URLstr = "http://www.bing.com/maps/default.aspx?v=2&cp=" _
                & Round(pPoint.y, 6) & "~" & Round(pPoint.x, 6) _
                & "&lvl=17&style=h"
 
        Case 2
        Exit Sub
     
    End Select
    
    'Use one of the constants as the window state parameter
    returnLong = OpenLocation(URLstr, SW_SHOWNORMAL)
    
End Sub


Private Function GoogleMap_Link_ToolTip() As String
    GoogleMap_Link_ToolTip = "Google / Bing Map"
End Function