IDataGraphT dataGraphT = new DataGraphTClass();
Sub profileTest() Dim mxDocument As IMxDocument Set mxDocument = ThisDocument Dim rasterLayer As IRasterLayer Set rasterLayer = mxDocument.FocusMap.layer(7) Dim surface As ISurface Set surface = GetSurfaceFromLayer(rasterLayer) Dim fromPoint As IPoint Set fromPoint = New point fromPoint.PutCoords 286000, 4271200 Dim toPoint As IPoint Set toPoint = New point toPoint.PutCoords 286500, 4271200 Dim polyline As IPolyline Set polyline = New polyline polyline.fromPoint = fromPoint polyline.toPoint = toPoint surface.GetProfile polyline, polyline Dim pointCollection As IPointCollection Set pointCollection = polyline Dim i As Long For i = 0 To pointCollection.PointCount - 1 Dim point As IPoint Set point = pointCollection.point(i) MsgBox point.X & ", " & point.Y & ", " & point.Z Next i End Sub Function GetSurfaceFromLayer(rasterLayer As IRasterLayer) As ISurface Dim surface As ISurface Dim layerExtensions As ILayerExtensions Set layerExtensions = rasterLayer Dim i As Long For i = 0 To layerExtensions.ExtensionCount - 1 Dim dddProperties As I3DProperties Set dddProperties = layerExtensions.Extension(i) If dddProperties.BaseOption = esriBaseSurface Then Set surface = dddProperties.BaseSurface End If Next If surface Is Nothing Then Dim rasterBandCollection As IRasterBandCollection Set rasterBandCollection = rasterLayer.Raster Dim rasterBand As IRasterBand Set rasterBand = rasterBandCollection.Item(0) Dim rasterSurface As IRasterSurface Set rasterSurface = New rasterSurface rasterSurface.rasterBand = rasterBand Set surface = rasterSurface End If Set GetSurfaceFromLayer = surface End Function
Aangemelde leden kunnen berichten plaatsen, updates volgen en meer. Nieuw hier? Registreer een gratis account.
Find useful guides, FAQs, and documents to help you navigate and make the most of Esri Community.