Displaying MOLE symbology with the GlobeControl
MainForm.vb
' Copyright 2010 ESRI
' 
' All rights reserved under the copyright laws of the United States
' and applicable international laws, treaties, and conventions.
' 
' You may freely redistribute and use this sample code, with or
' without modification, provided you include the original copyright
' notice and use restrictions.
' 
' See the use restrictions.
' 


Imports System
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Data
Imports System.Drawing
Imports System.Text
Imports System.Windows.Forms

Imports System.Diagnostics

Imports ESRI.ArcGIS.Controls
Imports ESRI.ArcGIS.GlobeCore
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.SystemUI
Imports ESRI.ArcGIS

Imports ESRI.ArcGIS.Carto
Imports ESRI.ArcGIS.DataSourcesGDB
Imports ESRI.ArcGIS.Geometry
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.DefenseSolutions

Namespace GlobeControlApp
  Public NotInheritable Partial Class MainForm
    Inherits Form

    #Region "private class members"
    Private m_globeControl As IGlobeControl = Nothing
    Private m_globeViewUtil As IGlobeViewUtil = Nothing
    #End Region

    #Region "class constructor"
        Public Sub New()
            RuntimeManager.Bind(ProductCode.Engine)
            InitializeComponent()
        End Sub
    #End Region

    #Region "Main Menu event handlers"
        Private Sub menuOpenDoc_Click(ByVal sender As Object, ByVal e As EventArgs) Handles menuOpenDoc.Click
            'execute Open Document command
            Dim command As ICommand = New ControlsGlobeOpenDocCommandClass()
            command.OnCreate(m_globeControl.[Object])
            command.OnClick()
        End Sub

        Private Sub menuExitApp_Click(ByVal sender As Object, ByVal e As EventArgs) Handles menuExitApp.Click
            'exit the application
            Application.[Exit]()
        End Sub
    #End Region

    ''' <summary>
    ''' Mouse move event handler
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
        Private Sub axGlobeControl1_OnMouseMove(ByVal sender As Object, ByVal e As IGlobeControlEvents_OnMouseMoveEvent) Handles axGlobeControl1.OnMouseMove
            Dim dLon As Double, dLat As Double, dAlt As Double
            'convert the window coordinate into geographic coordinates
            m_globeViewUtil.WindowToGeographic(m_globeControl.GlobeDisplay, m_globeControl.GlobeDisplay.ActiveViewer, e.x, e.y, True, dLon, _
             dLat, dAlt)

            'report the mouse geographic coordinate onto the statusbar
            statusBarXY.Text = String.Format("{0} {1} {2}", dLon.ToString("###.###"), dLat.ToString("###.###"), dAlt.ToString("###.###"))
        End Sub

        ' Called when a globe document is opened using the file open button or menu.
        Private Sub axGlobeControl1_OnGlobeReplaced(ByVal sender As System.Object, ByVal e As IGlobeControlEvents_OnGlobeReplacedEvent) Handles axGlobeControl1.OnGlobeReplaced

            ' Load the MOLE Unit Feature Class
            Dim globe As IGlobe = Me.axGlobeControl1.Globe
            m_MoleFC = LoadMoleFeatureClassInGlobe(globe)

        End Sub

        ' Checks if a valid MOLE feature class has been loaded onto the globe.
        Private Function MoleFcIsValid() As Boolean
            If m_MoleFC Is Nothing Then
                MessageBox.Show("Please open an ArcGlobe (.3dd) document" & Environment.NewLine & "before pressing this button.", _
                                "MOLE Globe", MessageBoxButtons.OK, MessageBoxIcon.Information)
                Return False
            End If
            Return True
        End Function

        Private Sub MainForm_FormClosing(ByVal sender As Object, ByVal e As FormClosingEventArgs) Handles MyBase.FormClosing

        End Sub


        ' The following code was added to a default(wizard generated)
        ' Globe Control Application in order to obtain a MOLE Layer in 3D,
        ' insert a feature, and refresh the layer.

        Private m_MoleFC As IFeatureClass = Nothing
        Private m_addedUnitCt As Integer = 0


    ''' <summary>
    ''' Form Load event handler
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
        Private Sub MainForm_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
            m_globeControl = TryCast(axGlobeControl1.[Object], IGlobeControl)

            'cast the GlobeViewUtil from the GlobeCamera
            m_globeViewUtil = TryCast(m_globeControl.GlobeCamera, IGlobeViewUtil)
        End Sub

    ''' <summary>
    ''' Add a "Add Unit" button and use this as its event handler
    ''' </summary>
        Private Sub butTest_Click(ByVal sender As Object, ByVal e As EventArgs) Handles butTest.Click
            If (Not MoleFcIsValid()) Then
                Return
            End If
            AddUnitToFC(m_MoleFC)

            Dim globeDisplay As IGlobeDisplay = axGlobeControl1.GlobeDisplay
            RefreshMoleLayers(globeDisplay)
        End Sub

    ''' <summary>
    ''' Add a "Move All Units" button and use this as its event handler
    ''' </summary>
        Private Sub butTest2_Click(ByVal sender As Object, ByVal e As EventArgs) Handles butTest2.Click
            If (Not MoleFcIsValid()) Then
                Return
            End If
            MoveAllUnits(m_MoleFC)

            Dim globeDisplay As IGlobeDisplay = axGlobeControl1.GlobeDisplay
            RefreshMoleLayers(globeDisplay)
        End Sub

    ''' <summary>
    ''' Refreshes all MOLE Layers in a GlobeControl
    ''' </summary>
    Private Sub RefreshMoleLayers(ByVal globeDisplay As IGlobeDisplay)
      Dim map As IBasicMap = TryCast(globeDisplay.Globe, IBasicMap)

      ' find the mole Force Element layers and refresh them
            Dim enumLayer As IEnumLayer = map.Layers(Nothing, True)

      enumLayer.Reset()
            Dim layer As ILayer = enumLayer.Next()
            While layer IsNot Nothing
                If TypeOf layer Is IForceElementLayer Then
                    ' Code required to get a MOLE Layer to rebuild & refresh in Globe
                    Dim MoleLayer As ICachedGraphicLayer = TryCast(layer, ICachedGraphicLayer)
                    MoleLayer.Refresh()

                    globeDisplay.SuspendTileFetch()

                    Dim layer3DSettings As I3DSettings = TryCast(MoleLayer, I3DSettings)

                    If layer3DSettings IsNot Nothing And layer3DSettings.DisplayOption <> mole3DDisplayEnum.mole3DDisplayExtrude Then
                        ' use optimized refresh
                        Dim display As ESRI.ArcGIS.Display.IDisplay = TryCast(globeDisplay, ESRI.ArcGIS.Display.IDisplay)
                        layer.Draw(esriDrawPhase.esriDPGeography, display, Nothing)
                    Else
                        ' Use normal GlobeDisplay refresh (Does not perform as well)
                        TryCast(globeDisplay, IGlobeDisplayLayers).RefreshLayer(layer)
                    End If

                    globeDisplay.ResumeTileFetch()

                End If
                    layer = enumLayer.Next()
            End While
    End Sub

    ''' <summary>
    ''' Adds a Unit to a feature class with the MOLE data model
    ''' </summary>
    Private Sub AddUnitToFC(ByVal featureClass As IFeatureClass)
      Try
        ' Random Number Generation (so each new unit shows up at a different point) 
        Const  maxRandom As Double = 5
        Dim randomGenerator As New System.Random()
        Dim dRandom As Double = randomGenerator.NextDouble() * maxRandom

        ' create the new feature
        Dim newFeature As IFeature = featureClass.CreateFeature()
        ' get an insert cursor
        Dim insertCursor As IFeatureCursor = featureClass.Insert(False)

        If newFeature IsNot Nothing Then
          ' create a random point for the unit's location
          Dim point As IPoint = New PointClass()
          point.PutCoords(-117 + dRandom, 35 + dRandom / 2)
          point.Z = 100

          Dim za As IZAware = TryCast(point, IZAware)
          za.ZAware = True

          ' set the feature's shape
          newFeature.Shape = TryCast(point, IGeometry)

          ' set feature fields (SIC, name)
                    Dim symbolIdCode As String = "S"
                    Dim affilCode As Char = "F"c

                    ' Set a different affiliation for each new unit added.
                    Dim affil As Integer = m_addedUnitCt Mod 4
                    Select Case affil
                        Case 0
                            affilCode = "F"c
                        Case 1
                            affilCode = "H"c
                        Case 2
                            affilCode = "N"c
                        Case 3
                            affilCode = "U"c
                        Case Else
                    End Select

                    ' Set the symbol ID code
                    symbolIdCode = symbolIdCode & affilCode & "GPUCI-----USG"
                    newFeature.Value(newFeature.Table.FindField("Symbol_ID")) = symbolIdCode

                    ' Increment the unit counter used for the unit label.
                    m_addedUnitCt += 1

                    ' Set the label for the unit graphic.
                    Dim testName As String = "Test Insert Unit " & m_addedUnitCt
                    newFeature.Value(newFeature.Table.FindField("Name")) = testName

          insertCursor.InsertFeature(TryCast(newFeature, IFeatureBuffer))
        End If

          ' make sure changes are committed before we exit
        insertCursor.Flush()
      Catch e As Exception
        Trace.WriteLine(e.Message)
      End Try
    End Sub

    ''' <summary>
    ''' Moves all point geometries in a Feature Class
    ''' </summary>
    Private Sub MoveAllUnits(ByVal featureClass As IFeatureClass)
      Try
        ' get all features
        Dim updateCursor As IFeatureCursor = featureClass.Update(Nothing, False)

        Dim updateFeature As IFeature = updateCursor.NextFeature()

        While updateFeature IsNot Nothing
          Dim geometry As IGeometry = updateFeature.Shape
          Dim point As IPoint = TryCast(geometry, IPoint)

          ' make sure not an empty/corrupt geometry
          If (geometry IsNot Nothing) AndAlso (point IsNot Nothing) AndAlso (Not geometry.IsEmpty) Then
            point.X += 0.2
            updateFeature.Shape = geometry
            updateCursor.UpdateFeature(updateFeature)
          End If

          updateFeature = updateCursor.NextFeature()
        End While
      Catch e As Exception
        Trace.WriteLine(e.Message)
      End Try
    End Sub

    ''' <summary>
    ''' Loads a MOLE Layer in Globe
    ''' </summary>
    ''' <remarks>
    ''' This is very similar to the 2D usage with additional code to 
    ''' set the I3DSettings properties for the layer
    ''' </remarks>
    Private Function LoadMoleFeatureClassInGlobe(ByVal globe As IGlobe) As IFeatureClass
      Dim dbPath As String = MoleMDB
      Dim fc As IFeatureClass = LoadAccessFeatureClass(dbPath, "FriendlyForces")

      Debug.WriteLine("Attempting to Add MOLE Layer")

      Dim pFeatureLayer As IGeoFeatureLayer = TryCast(New FeatureLayer(), IGeoFeatureLayer)
      pFeatureLayer.FeatureClass = fc

      'Create a MOLE layer and attach the feature layer to it
      Dim pLayer As ICachedGraphicFeatureLayer = TryCast(New ForceElementLayer(), ICachedGraphicFeatureLayer)
      pLayer.FeatureLayer = pFeatureLayer

      'Set the size for symbols in the layer     
      Dim pForceElementLayer As IForceElementLayer = TryCast(pLayer, IForceElementLayer)
            pForceElementLayer.Size = 0.2

      ' Set 3D Settings
      Dim p3DSettings As I3DSettings = TryCast(pForceElementLayer, I3DSettings)
      p3DSettings.DisplayOption = mole3DDisplayEnum.mole3DDisplayBoth
      ' or .mole3DDisplayExtrude; // or mole3DDisplayDrape
      p3DSettings.EnableCallouts = True
      p3DSettings.DefaultElevationMeters = 10000

      Dim layer As ILayer = TryCast(pLayer, ILayer)
      layer.Name = "MOLE 3D Unit Layer"

      globe.AddLayerType(layer, ESRI.ArcGIS.GlobeCore.esriGlobeLayerType.esriGlobeLayerTypeDraped, True)

      System.Diagnostics.Debug.WriteLine("Layer Added")

      Return fc
    End Function

    ''' <summary>
    ''' Opens a Feature Class from an Access PGDB
    ''' </summary>
    Private Function LoadAccessFeatureClass(ByVal dbPath As String, ByVal featureClassName As String) As IFeatureClass
      ' open the access database
      Dim pWSF As IWorkspaceFactory = New AccessWorkspaceFactoryClass()
      Dim pWS As IWorkspace = pWSF.OpenFromFile(dbPath, 0)

      ' make sure the database was opened
      If pWS Is Nothing Then
        MessageBox.Show("Could not locate and/or open database at: """ + dbPath + """", "Error!")
        Return Nothing
      End If

      Dim pFWS As IFeatureWorkspace = TryCast(pWS, IFeatureWorkspace)
      Dim pFC As IFeatureClass
      SyncLock pFWS
        ' lock to prevent multi-process access
        ' open the feature class
        pFC = pFWS.OpenFeatureClass(featureClassName)
      End SyncLock

      ' make sure the feature class was opened
      If pFC Is Nothing Then
        MessageBox.Show("Could not open feature class: " + featureClassName + ".", "Error!")
        Return Nothing
      End If

      Return pFC
    End Function

    ''' <summary>
    ''' Path to ArcGIS Install
    ''' </summary>

        Private Function GetSdkDataPath() As String
            'get the ArcGIS path from the registry
            Dim key As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.LocalMachine.OpenSubKey("SOFTWARE\ESRI\ArcGIS_SXS_SDK")
            Dim path As String = Convert.ToString(key.GetValue("InstallDir"))

            'set the of the logo
            Dim str As String = System.IO.Path.Combine(path, "Samples\data\")
            If (Not System.IO.Directory.Exists(str)) Then
                MessageBox.Show("Path :" & str & " does not exist!")
                Return String.Empty
            End If

            Return str
        End Function

    ''' <summary>
        ''' Path to MOLE globe Access PGDB data file
    ''' </summary>
        Public ReadOnly Property MoleMDB() As String
            Get
                If m_DataPath Is Nothing Then
                    m_DataPath = GetSdkDataPath() + "MilitaryOverlayEditor\mole_globe.mdb"
                End If

                Return m_DataPath
            End Get
        End Property
    Private Shared m_DataPath As String = Nothing



  End Class
End Namespace