Repair Datasource

I had a number of ArcScene documents (sxd) with several layers (>20) with a broken source, and I didn't really feel like manually going through each one and repairing it, so I poked around trying to find an example to do it in VBA. Most of the examples were for feature layers, whereas these were all raster layers, and none were for ArcScene. I found one that worked for rasters, but then I lost the renderer and layer name which were both important in the file.

This is the mesh that I came up with. Probably a good idea to save your sxd as something else before running the code. I also needed to close out and open back up before the settings took effect. The base heights disappeared and I'm not sure why this happened but I already had a bit of code to set the base height to the layer because I'm lazy and didn't want to go layer by layer setting the base heights.

Here is the code to set the source:

Private Sub SetSource()
Dim pDoc As ISxDocument: Set pDoc = ThisDocument
Dim pScene As IScene: Set pScene = pDoc.Scene
Dim pSG As ISceneGraph: Set pSG = pScene.SceneGraph
Dim pSV As ISceneViewer: Set pSV = pSG.ActiveViewer
Dim il As Integer
Dim pNewWorkspaceName As IWorkspaceName
Set pNewWorkspaceName = New WorkspaceName
With pNewWorkspaceName
    .PathName = "D:\gamblingout"
    .WorkspaceFactoryProgID = "esriDataSourcesRaster.RasterWorkspaceFactory.1"
End With

For il = 1 To pScene.layerCount - 1
    Dim pLayer As ILayer: Set pLayer = pScene.Layer(il)
    Dim pRLayer As IRasterLayer: Set pRLayer = pLayer
    Dim pDataLayer2 As IDataLayer2: Set pDataLayer2 = pRLayer
    Dim pDatasetName As IDatasetName
    Set pDatasetName = pDataLayer2.DataSourceName
    Set pDatasetName.WorkspaceName = pNewWorkspaceName
    pDataLayer2.DataSourceName = pDatasetName
    pDoc.UpdateContents
Next
End Sub

You will probably need to change the start layer, as I had it set as 1 instead of 0.

Here is the code for the base heights.

Public Sub Set3d()
Dim pDoc As ISxDocument: Set pDoc = ThisDocument
Dim pScene As IScene: Set pScene = pDoc.Scene

Dim il As Integer
  For il = 1 To pScene.layerCount

      Dim pLayer As ILayer: Set pLayer = pScene.Layer(il)
      Dim pLayerExt As ILayerExtensions: Set pLayerExt = pLayer
      Dim p3dProps As I3DProperties

      Dim i As Integer
    
  '   look for 3D properties of layer:
      For i = 0 To pLayerExt.ExtensionCount - 1
          If TypeOf pLayerExt.Extension(i) Is I3DProperties Then
              Set p3dProps = pLayerExt.Extension(i)
              Exit For
          End If
      Next
      Dim pSurf As IRasterSurface
      Dim pBands As IRasterBandCollection
      Dim pRasterLayer As IRasterLayer
      Set pRasterLayer = pLayer
      p3dProps.BaseOption = esriBaseSurface
      Set pSurf = New RasterSurface
      Set pBands = pRasterLayer.Raster
      pSurf.RasterBand = pBands.Item(0)
      Set p3dProps.BaseSurface = pSurf
      p3dProps.Apply3DProperties pLayer
  Next
  pDoc.UpdateContents

End Sub

There are no checks to make sure the layer is raster and not a feature layer. This is one area that could be expanded. Since it is for a fairly custom file, I know which layers are what type.