'レイヤからサーフェス(ISurface)の取得 Private Function GetSurfaceFromLayer(Optional sLayer, Optional OrActualLayer As ILayer) As ISurface Dim pLayer As ILayer Dim pTin As ITin Dim pRLayer As IRasterLayer Dim pTLayer As ITinLayer Dim pSurf As IRasterSurface Dim pBands As IRasterBandCollection Dim sName As String On Error GoTo GetSurfaceFromLayer_ERR ' get the layer: If OrActualLayer Is Nothing Then Set pLayer = GetLayer(sLayer) Else Set pLayer = OrActualLayer End If If pLayer Is Nothing Then Exit Function If TypeOf pLayer Is IRasterLayer Then Set pRLayer = pLayer Dim p3DProp As I3DProperties Dim pLE As ILayerExtensions Set pLE = pLayer Dim i As Integer ' look for 3D properties of layer: For i = 0 To pLE.ExtensionCount - 1 If TypeOf pLE.Extension(i) Is I3DProperties Then Set p3DProp = pLE.Extension(i) Exit For End If Next ' look first for base surface of layer: Set pSurf = p3DProp.BaseSurface ' if not found, try first band of raster: If pSurf Is Nothing Then If Not pRLayer.Raster Is Nothing Then Set pSurf = New RasterSurface Set pBands = pRLayer.Raster pSurf.RasterBand = pBands.Item(0) sName = pLayer.Name End If Else End If Set GetSurfaceFromLayer = pSurf ElseIf TypeOf pLayer Is ITinLayer Then ' get the surface off the tin layer: Set pTLayer = pLayer Set GetSurfaceFromLayer = pTLayer.Dataset Else End If Exit Function GetSurfaceFromLayer_ERR: Debug.Print "GetSurfaceFromLayer_ERR: " & vbCrLf & Err.Description Debug.Assert 0 End Function
レイヤからサーフェス(ISurface)の取得
2016/9/1 (木)