Hatena::Groupvbscript

GoogleEarth.ApplicationGE

主要な Windows 標準コンポーネントの一覧 → http://vbscript.g.hatena.ne.jp/keyword/ProgID
VBScript 基礎文法最速マスター → http://vbscript.g.hatena.ne.jp/cx20/20100131/1264906231

GoogleEarth.ApplicationGE

GoogleEarth.ApplicationGE

概要

GoogleEarth.ApplicationGE は、Google Earth を操作するための COM コンポーネントを識別する ProgID です。

サンプル

' File Name : SearchGoogleEarth.vbs
' Usage : CScript //Nologo SearchGoogleEarth.vbs
Option Explicit

Const g_timeOut = 10
Const g_sleep = 1000

Call Main()

Sub Main()
    LogTraceFunc "Main"
    Dim strSearchString
    strSearchString = "東京タワー"
    ' 「東京タワー」を検索して表示
    SearchGoogleEarth strSearchString
End Sub

Sub SearchGoogleEarth( strSearchString )
    LogTraceFunc "SearchGoogleEarth"
    Dim ge
    Set ge = CreateObject("GoogleEarth.ApplicationGE")
    
    ' 初期化待ち
    WaitInitializeOfGoogleEarth ge
    
    Dim sc
    Set sc = ge.SearchController
    ' 検索実行
    sc.Search strSearchString
    
    ' 検索処理待ち
    WaitProgressOfSearchController sc
    
    ' 表示待ち
    WaitStreamingOfGoogleEarth ge
End Sub

Sub WaitInitializeOfGoogleEarth( ge )
    LogTraceFunc "WaitInitializeOfGoogleEarth"
    Dim nCount
    nCount = 0
    While ( ge.IsInitialized = 0 Or ge.IsOnline = 0 ) And ( Not IsTimeOut( nCount ) )
        LogTrace "ge.IsInitialized = [" & ge.IsInitialized & "]"
        LogTrace "ge.IsOnline = [" & ge.IsOnline & "]"
        nCount = nCount + 1
        DoSleep
    Wend
End Sub

Sub WaitProgressOfSearchController( sc )
    LogTraceFunc "WaitProgressOfSearchController"
    Dim nCount
    nCount = 0
    While sc.IsSearchInProgress And ( Not IsTimeOut( nCount ) )
        nCount = nCount + 1
        DoSleep
    Wend
End Sub

Sub WaitStreamingOfGoogleEarth( ge )
    LogTraceFunc "WaitStreamingOfGoogleEarth"
    While ge.StreamingProgressPercentage < 100
        LogTrace "ge.StreamingProgressPercentage = [" & ge.StreamingProgressPercentage & "]"
        DoSleep
    Wend
End Sub

Function IsTimeOut( nCount )
    Dim bResult
    If nCount > g_timeOut Then
        bResult = True
    Else
        bResult = False
    End If
    IsTimeOut = bResult
End Function

Sub DoSleep()
    WScript.Sleep g_sleep
End Sub

Sub LogTraceFunc( strFuncName )
    LogTrace "Function : [" & strFuncName & "]"
End Sub

Sub LogTrace( strMessage )
    WScript.Echo Date & " " & Time & " " & "[TRACE] " & strMessage
End Sub
実行結果

参考情報