ラスター レイヤーから断面を作成

Sub GetInterpolateShapeFromRaster()
    Dim pMxDocument As IMxDocument
    Set pMxDocument = ThisDocument
    
    Dim pRasterLayer As IRasterLayer
    Set pRasterLayer = pMxDocument.FocusMap.Layer(0)
    
    'Dim pRasterBandCollection As IRasterBandCollection
    'Set pRasterBandCollection = pRasterLayer.Raster
    
    
    Dim pRasterSurface As IRasterSurface
    Set pRasterSurface = New RasterSurface
    'pRasterSurface.RasterBand = pRasterBandCollection.Item(0)
    pRasterSurface.PutRaster pRasterLayer.Raster, 0 'Rasterからサーフェス用ラスタを取得
    
    Dim pSurface As ISurface
    Set pSurface = pRasterSurface
    
    
    
    Dim pEnumGeometry As IEnumGeometry
    Set pEnumGeometry = GetGraphicElements(pMxDocument.FocusMap)
    
    Dim pInputGeometry As IGeometry
    Set pInputGeometry = pEnumGeometry.Next
    
    Dim pInputCurve As ICurve
    Set pInputCurve = pInputGeometry
    
    Dim pInputCurve3D As ICurve3D
    Set pInputCurve3D = pInputGeometry
    
    Debug.Print "Input:", pInputCurve.Length
    
    Dim pOutGeometry As IGeometry
    
    
    
    Call pSurface.InterpolateShape(pInputGeometry, pOutGeometry)
    
    Dim pOutCurve3D As ICurve3D
    Set pOutCurve3D = pOutGeometry
    
    Debug.Print "Output:", pOutCurve3D.Length3D

End Sub





'グラフィックからすべてのジオメトリを取得
Public Function GetGraphicElements(GraphicsContainer As IGraphicsContainer) As IEnumGeometry
    GraphicsContainer.Reset
    
    Dim pElement As IElement
    Set pElement = GraphicsContainer.Next
    
    Dim pGeometryCollection As IGeometryCollection
    Set pGeometryCollection = New GeometryBag
    
    Do Until pElement Is Nothing
        
        pGeometryCollection.AddGeometry pElement.Geometry
        
        Set pElement = GraphicsContainer.Next
    
    Loop
    
    Set GetGraphicElements = pGeometryCollection

End Function