Monday, September 29, 2008

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
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
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

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.

No comments: