01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | 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 |
ラスター レイヤーから断面を作成
2016/9/1 (木)