Add a Survey Layer to the Map

Created:12/19/2002
Description:

This sample adds a survey layer to the map.

How to use:
  1. Start a new map document.
  2. Open VBA (Alt+F11 shortcut)
  3. Click Tools, and click references.
  4. Check the following ESRI Survey Analyst Libraries, then click OK: ESRI Survey Analyst Object Library, ESRI Survey Analyst PointPackage Library, ESRI Survey Analyst COGOPackage Library, ESRI Survey Analyst TPSPackage Library.
  5. Paste the code into VBA and run the subroutine called AddProjectToNewSurveyLayer.
  6. In the first input box enter a path to a personal geodatabase or SDE connection file.
  7. In the second input box enter a survey dataset name.
  8. In the 3rd input box enter a survey project name.
Private Sub AddProjectToNewSurveyLayer()
'1.-->Get the geodatabase, survey dataset, and survey project
  Dim sDatabase As String
  sDatabase = InputBox("Enter the path\name of the Geodatbase or its Connection File:", "", _
          "D:\SurveyAnalyst\Test_Tutorial_Data\Survey\Arizona.mdb")
  Dim sSurveyDataset As String
  sSurveyDataset = InputBox("Enter the name of the Survey Dataset:", "", "SurveyDataset1")
  Dim sSurvey As String
  sSurvey = InputBox("Enter the name of the Survey Project:", "", "Project1")
'2.-->Determine whether or not the geodatabase is personal or SDE
  Dim pWKSFactory As IWorkspaceFactory
  Dim DatabaseCheck As Boolean, bIsPersonal As Boolean
  bIsPersonal = True
  If Not DatabaseCheck Then
    Set pWKSFactory = New SdeWorkspaceFactory
    If pWKSFactory.IsWorkspace(sDatabase) Then bIsPersonal = False
    If bIsPersonal Then
      Set pWKSFactory = New AccessWorkspaceFactory
    Else
      Set pWKSFactory = New SdeWorkspaceFactory
    End If
  End If
'3.-->Open the workspace from the SDE connection file or personal geodatabase
  Dim pWS As IWorkspace: Set pWS = pWKSFactory.OpenFromFile(sDatabase, 0)
'4.-->Get the survey database workspace extension
  Dim pWSExtMan As IWorkspaceExtensionManager: Set pWSExtMan = pWS
  Dim pWsExt As IWorkspaceExtension
  Dim l_Ext As Long
  For l_Ext = 0 To pWSExtMan.ExtensionCount - 1
    If pWSExtMan.Extension(l_Ext).Name = "Survey Database" Then
      Set pWsExt = pWSExtMan.Extension(l_Ext)
    End If
  Next l_Ext
'5.-->Get the survey dataset from the workspace extension
  Dim m_pSDSExtension As ISurveyDatasetExtension: Set m_pSDSExtension = pWsExt
  Dim pSDS As ISurveyDataset: Set pSDS = m_pSDSExtension.OpenSurveyDataset(sSurveyDataset)
'6.-->Query interface to the ISurveyContainer interface
  Dim pSurvCon As ISurveyContainer: Set pSurvCon = pSDS
'7.-->Check to see if the survey dataset is the container of the survey project you require.
  Dim pSurvey As ISurvey: Set pSurvey = pSurvCon.SurveyByName(sSurvey)
 'If not then go through all the survey project folders in the survey dataset to see if they
 'hold the project you need to add to the new survey layer
 If pSurvey Is Nothing Then
    Dim pEnumSrvFolders As IEnumSurveyFolder: Set pEnumSrvFolders = pSDS.SearchSurveyFolders("")
    pEnumSrvFolders.Reset
    Dim pSrvFolder As ISurveyFolder: Set pSrvFolder = pEnumSrvFolders.Next
    Do While Not pSrvFolder Is Nothing
      Set pSurvCon = pSrvFolder
      Set pSurvey = pSurvCon.SurveyByName(sSurvey)
      If Not pSurvey Is Nothing Then
        Exit Do
      End If
      Set pSrvFolder = pEnumSrvFolders.Next
    Loop
  End If
'8.-->If the survey project is not found then exit.
  If pSurvey Is Nothing Then
    MsgBox "No survey found."
    Exit Sub
  End If
'9.-->The survey project exists, and can be added to a new survey layer in the map.
  AddSurveyLayer pSDS, pSurvey
End Sub

Private Sub AddSurveyLayer(ByRef pSurveyDataset As ISurveyDataset, pSurvey As ISurvey)
'1.-->Create an instance of a new point renderer for survey points and pass it to CreatSubLayer
  Dim pPointRenderer As IASPointRenderer: Set pPointRenderer = New ASPointRenderer
  Dim pPointSubLyr As ISurveySubLayer: Set pPointSubLyr = CreateSubLayer(pPointRenderer, pSurveyDataset)
'2.-->Create an instance of a new COGO measurement renderer and pass it to CreatSubLayer
  Dim pCGMeasRenderer As ICOGOMeasurementRenderer: Set pCGMeasRenderer = New COGOMeasurementRenderer
  Dim pCGMeasSubLyr As ISurveySubLayer: Set pCGMeasSubLyr = CreateSubLayer(pCGMeasRenderer, pSurveyDataset)
'3.-->Create an instance of a new TPS measurement renderer and pass it to CreatSubLayer
  Dim pTPSMeasRenderer As ITPSMeasurementRenderer: Set pTPSMeasRenderer = New TPSMeasurementRenderer
  Dim pTPSMeasSubLyr As ISurveySubLayer: Set pTPSMeasSubLyr = CreateSubLayer(pTPSMeasRenderer, pSurveyDataset)
'4.-->Create a new instance of a survey layer
  Dim pSurveyLayer As ISurveyLayer: Set pSurveyLayer = New SurveyLayer
  'Query interface to the IDataLayer interface
  Dim pDataLyr As IDataLayer: Set pDataLyr = pSurveyLayer
  'Query interface to the IDataset interface
  Dim pDataset As IDataset: Set pDataset = pSurveyDataset
  'Give the data layer a pointer to IName
  pDataLyr.DataSourceName = pDataset.FullName
'5.-->Set the properties of the survey layer
  With pSurveyLayer
   .ShowAllSurveys = False
   .AddSurvey pSurvey
   .Selectable = True
   .AddSubLayer pPointSubLyr, True
   .AddSubLayer pCGMeasSubLyr, True
   .AddSubLayer pTPSMeasSubLyr, True
  End With
  'Query interface to the ILayer interface, and give the survey layer a name.
  Dim pLayer As ILayer: Set pLayer = pSurveyLayer
  pLayer.Name = pSurveyDataset.Name
'6.-->Add the survey layer to the map
  Dim pMXDoc As IMxDocument: Set pMXDoc = Application.Document
  Dim pMap As IMap: Set pMap = pMXDoc.FocusMap
  pMap.AddLayer pLayer
End Sub

Private Function CreateSubLayer(pRenderer As ISurveyRenderer, pSurveyDataset As ISurveyDataset) As ISurveySubLayer
  'First make sure the survey dataset can be handled by the renderer
  If pRenderer.CanHandle(pSurveyDataset) Then
    '1.-->Initialize the renderer
    pRenderer.Init pSurveyDataset, True, Nothing
    '2.-->create a new instance of a sub layer object
    Set CreateSubLayer = New SurveySubLayer
    '3.-->Define the properties for the survey sub layer and initialize it
    With CreateSubLayer
      .Selectable = True
      .ScaleSymbols = False
      .Init pRenderer
    End With
    'Query interface to the ILayer interface, and give it a name
    Dim pLayer As ILayer: Set pLayer = CreateSubLayer
    pLayer.Name = pRenderer.Name
  End If
End Function