GPPointFileInfo\OutputFeatureBuffer.vb
Creating a non-trival custom GP tool - inputs, outputs, and responding to environment settings
GPPointFileInfo\OutputFeatureBuffer.vb
' Copyright 2008 ESRI
' 
' All rights reserved under the copyright laws of the United States
' and applicable international laws, treaties, and conventions.
' 
' You may freely redistribute and use this sample code, with or
' without modification, provided you include the original copyright
' notice and use restrictions.
' 
' See use restrictions at <your ArcGIS install location>/developerkit/userestrictions.txt.
' 

Imports Microsoft.VisualBasic
Imports System
Imports System.Runtime.InteropServices
Imports ESRI.ArcGIS.Geoprocessing
Imports ESRI.ArcGIS.Geometry
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.GeoDatabaseExtensions

Namespace GPPointFileInfo
  Public Class OutputFeatureBuffer
        Implements GPPointFileInfo.IOutputFeatureBuffer
    Private _featureBuffer As IFeatureBuffer

    Public Sub New(ByVal inputFile As IInputFile, ByVal gpInputFileFormat As IGPInputFileFormat, ByVal inputSpatialReference As ISpatialReference, ByVal outputSpatialReference As ISpatialReference, ByVal outputHasZ As IOutputHasZ, ByVal gpOutputFeatureClass As IGPOutputFeatureClass, ByVal esExtent As IESExtent)
      Dim terrainDataImporter As ITerrainDataImporter = GetTerrainDataImporter(gpInputFileFormat, inputFile)

      Dim pointCount As Double = GetPointCount(terrainDataImporter)

      Dim envelope As IEnvelope = GetEnvelope(terrainDataImporter, inputSpatialReference, outputSpatialReference)

      ValidateEnvelope(envelope, esExtent)

      Dim xMin As Double = GetXMin(envelope)
      Dim xMax As Double = GetXMax(envelope)
      Dim yMin As Double = GetYMin(envelope)
      Dim yMax As Double = GetYMax(envelope)
      Dim zMin As Double = GetZMin(envelope)
      Dim zMax As Double = GetZMax(envelope)

      Dim geometry As IGeometry = GetGeometry(envelope, outputHasZ, inputSpatialReference, outputSpatialReference)

      ValidateGeometry(geometry)

      Dim averagePointSpacing As Double = GetAveragePointSpacing(envelope, pointCount)

      ValidateAveragePointSpacing(averagePointSpacing)

      _featureBuffer = GetFeatureBuffer(gpOutputFeatureClass, geometry, inputFile, pointCount, averagePointSpacing, xMin, xMax, yMin, yMax, zMin, zMax)
    End Sub

        Public ReadOnly Property FeatureBuffer() As IFeatureBuffer Implements IOutputFeatureBuffer.FeatureBuffer
            Get
                Return _featureBuffer
            End Get
        End Property

    Private Function GetTerrainDataImporter(ByVal gpInputFileFormat As IGPInputFileFormat, ByVal inputFile As IInputFile) As ITerrainDataImporter
      Dim terrainDataImporter As ITerrainDataImporter

      Select Case gpInputFileFormat.FileFormat
        Case "XYZ"
          terrainDataImporter = GetTerrainXYZDataImporter(inputFile)
        Case "GENERATE"
          terrainDataImporter = GetTerrainGENERATEDataImporter(inputFile)
        Case "LAS"
          terrainDataImporter = GetTerrainLASDataImporter(inputFile)
        Case Else
          Throw New GPException(GPExceptionSeverity.Error, "Invalid Output Feature Buffer. Unable To Get Terrain Data Importer. Unhandled Case." & ObjectToString.GetNewline() & "gpInputFileFormat: " & ObjectToString.GetToString(gpInputFileFormat))
      End Select

      Return terrainDataImporter
    End Function

    Private Function GetTerrainXYZDataImporter(ByVal inputFile As IInputFile) As ITerrainDataImporter
            Dim terrainDataImporter As ITerrainDataImporter = New TerrainAsciiDataImporterClass()

            Dim terrainAsciiDataImporter As ITerrainAsciiDataImporter = TryCast(terrainDataImporter, ITerrainAsciiDataImporter)

            terrainAsciiDataImporter.FileFormat = esriTerrainAsciiDataFormatType.esriTerrainAsciiDataFormatXYZ

            Try
                terrainDataImporter.AddFile(inputFile.Path)
            Catch ex As COMException
                Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Unable To Add File To Terrain XYZ Data Importer." & ObjectToString.GetNewline() & "inputFile: " & ObjectToString.GetToString(inputFile), ex)
            End Try

            Return terrainDataImporter
    End Function

    Private Function GetTerrainGENERATEDataImporter(ByVal inputFile As IInputFile) As ITerrainDataImporter
            Dim terrainDataImporter As ITerrainDataImporter = New TerrainAsciiDataImporterClass()

            Dim terrainAsciiDataImporter As ITerrainAsciiDataImporter = TryCast(terrainDataImporter, ITerrainAsciiDataImporter)

            terrainAsciiDataImporter.FileFormat = esriTerrainAsciiDataFormatType.esriTerrainAsciiDataFormatGenerate

            Try
                terrainDataImporter.AddFile(inputFile.Path)
            Catch ex As COMException
                Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Unable To Add File To Terrain GENERATE Data Importer." & ObjectToString.GetNewline() & "inputFile: " & ObjectToString.GetToString(inputFile), ex)
            End Try

            Return terrainDataImporter
    End Function

    Private Function GetTerrainLASDataImporter(ByVal inputFile As IInputFile) As ITerrainDataImporter
      Const ReturnNumber As esriTerrainLasReturnType = esriTerrainLasReturnType.esriTerrainLasReturnAll

            Dim terrainDataImporter As ITerrainDataImporter = New TerrainLasDataImporterClass()

            Dim terrainLasDataImporter As ITerrainLasDataImporter = TryCast(terrainDataImporter, ITerrainLasDataImporter)

            terrainLasDataImporter.AddReturnNumber(ReturnNumber)

            Try
                terrainDataImporter.AddFile(inputFile.Path)
            Catch ex As COMException
                Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Unable To Add File To Terrain LAS Data Importer." & ObjectToString.GetNewline() & "inputFile: " & ObjectToString.GetToString(inputFile), ex)
            End Try

            Return terrainDataImporter
    End Function

    Private Function GetPointCount(ByVal terrainDataImporter As ITerrainDataImporter) As Double
      Dim pointCount As Double

      Try
        pointCount = terrainDataImporter.GetPointCount()
      Catch ex As COMException
        Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Unable To Get Point Count From Terrain Data Importer." & ObjectToString.GetNewline() & "terrainDataImporter: " & ObjectToString.GetToString(terrainDataImporter), ex)
      End Try

      Return pointCount
    End Function

    Private Function GetEnvelope(ByVal terrainDataImporter As ITerrainDataImporter, ByVal inputSpatialReference As ISpatialReference, ByVal outputSpatialReference As ISpatialReference) As IEnvelope
      Dim envelope As IEnvelope

      Dim spatialReference As ESRI.ArcGIS.Geometry.ISpatialReference
      If inputSpatialReference.IsUnknown Then
        spatialReference = outputSpatialReference.SpatialReference
      Else
        spatialReference = inputSpatialReference.SpatialReference
      End If

      Try
        envelope = terrainDataImporter.GetDataExtent(spatialReference)
      Catch ex As COMException
        Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Unable To Get Data Extent From Terrain Data Importer." & ObjectToString.GetNewline() & "terrainDataImporter: " & ObjectToString.GetToString(terrainDataImporter) & "spatialReference: " & ObjectToString.GetToString(spatialReference), ex)
      End Try

      Return envelope
    End Function

    Private Sub ValidateEnvelope(ByVal envelope As IEnvelope, ByVal esExtent As IESExtent)
      If envelope Is Nothing Then
        Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Invalid Envelope. Envelope Is Null.")
      ElseIf envelope.IsEmpty Then
        Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Invalid Envelope. Envelope Is Empty.")
      ElseIf envelope.SpatialReference Is Nothing Then
        Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Invalid Envelope. Envelope Spatial Reference Is Null.")
      Else
        If (Not esExtent.Envelope Is Nothing) AndAlso ((Not Intersect(esExtent.Envelope, envelope))) Then
          Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Invalid Envelope. Envelope Does Not Intersect Extent." & ObjectToString.GetNewline() & "envelope: " & ObjectToString.GetToString(envelope) & "esExtent: " & ObjectToString.GetToString(esExtent))
        End If
      End If
    End Sub

    Private Function Intersect(ByVal envelopeA As IEnvelope, ByVal envelopeB As IEnvelope) As Boolean

            Dim blnIntersect As Boolean

            Dim relationalOperator As IRelationalOperator = TryCast(envelopeA, IRelationalOperator)

            Dim geometry As IGeometry = TryCast(envelopeB, IGeometry)

            Try
                blnIntersect = Not relationalOperator.Disjoint(geometry)
            Catch ex As COMException
                Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Unable To Determine If Envelopes Intersect." & ObjectToString.GetNewline() & "envelopeA: " & ObjectToString.GetToString(envelopeA) & "envelopeB: " & ObjectToString.GetToString(envelopeB), ex)
            End Try

            Return blnIntersect
    End Function

    Private Function GetXMin(ByVal envelope As IEnvelope) As Double
      Return envelope.XMin
    End Function

    Private Function GetXMax(ByVal envelope As IEnvelope) As Double
      Return envelope.XMax
    End Function

    Private Function GetYMin(ByVal envelope As IEnvelope) As Double
      Return envelope.YMin
    End Function

    Private Function GetYMax(ByVal envelope As IEnvelope) As Double
      Return envelope.YMax
    End Function

    Private Function GetZMin(ByVal envelope As IEnvelope) As Double
      Return envelope.ZMin
    End Function

    Private Function GetZMax(ByVal envelope As IEnvelope) As Double
      Return envelope.ZMax
    End Function

    Private Function GetGeometry(ByVal envelope As IEnvelope, ByVal outputHasZ As IOutputHasZ, ByVal inputSpatialReference As ISpatialReference, ByVal outputSpatialReference As ISpatialReference) As IGeometry
      Dim geometry As IGeometry

      If outputHasZ.HasZ Then
        geometry = Get3DGeometry(envelope)
      Else
        geometry = Get2DGeometry(envelope)
      End If

      If ((Not outputSpatialReference.IsUnknown)) AndAlso ((Not inputSpatialReference.IsUnknown)) Then
        Try
          geometry.Project(outputSpatialReference.SpatialReference)
        Catch ex As COMException
          Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Unable To Project Geometry From Input Spatial Reference To Output Spatial Reference." & ObjectToString.GetNewline() & "geometry: " & ObjectToString.GetToString(geometry) & "inputSpatialReference: " & ObjectToString.GetToString(inputSpatialReference) & "outputSpatialReference: " & ObjectToString.GetToString(outputSpatialReference), ex)
        End Try
      End If

      Return geometry
    End Function

    Private Function Get2DGeometry(ByVal envelope As IEnvelope) As IGeometry
      Dim geometry As IGeometry = New PolygonClass()

      Dim pointCollection As IPointCollection = TryCast(geometry, IPointCollection)

      Dim missing As Object = Type.Missing

      pointCollection.AddPoint(envelope.UpperRight, missing, missing)
      pointCollection.AddPoint(envelope.LowerRight, missing, missing)
      pointCollection.AddPoint(envelope.LowerLeft, missing, missing)
      pointCollection.AddPoint(envelope.UpperLeft, missing, missing)

      Dim polygon As IPolygon = TryCast(pointCollection, IPolygon)

      polygon.Close()

      geometry.SpatialReference = envelope.SpatialReference

      Return geometry
    End Function

    Private Function Get3DGeometry(ByVal envelope As IEnvelope) As IGeometry
      Dim geometry As IGeometry

      Dim geometry2D As IGeometry = Get2DGeometry(envelope)

      Dim extrude As IExtrude = New GeometryEnvironmentClass()

      Try
        geometry = extrude.ExtrudeFromTo(envelope.ZMin, envelope.ZMax, geometry2D)
      Catch ex As COMException
        Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Unable To Extrude From Envelope Z Min To Envelope Z Max Using Base 2D Geometry." & ObjectToString.GetNewline() & "extrude: " & ObjectToString.GetToString(extrude) & "envelope.ZMin: " & ObjectToString.GetToString(envelope.ZMin) & "envelope.ZMax: " & ObjectToString.GetToString(envelope.ZMax) & "geometry2D: " & ObjectToString.GetToString(geometry2D), ex)
      End Try

      Return geometry
    End Function

    Private Sub ValidateGeometry(ByVal geometry As IGeometry)
      If geometry Is Nothing Then
        Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Invalid Geometry. Geometry Is Null.")
      ElseIf geometry.IsEmpty Then
        Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Invalid Geometry. Geometry Is Empty.")
      End If
    End Sub

    Private Function GetAveragePointSpacing(ByVal envelope As IEnvelope, ByVal pointCount As Double) As Double
      Dim averagePointSpacing As Double

      Dim area As IArea = TryCast(envelope, IArea)

      If area.Area <= 0 Then
        Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Unable To Get Average Point Spacing. area.Area <= 0." & ObjectToString.GetNewline() & "area.Area: " & ObjectToString.GetToString(area.Area))
      End If

      Dim averageAreaPerPoint As Double = GetAverageAreaPerPoint(area, pointCount)

      If averageAreaPerPoint <= 0 Then
        Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Unable to Get Average Point Spacing. averageAreaPerPoint <= 0." & ObjectToString.GetNewline() & "averageAreaPerPoint: " & ObjectToString.GetToString(averageAreaPerPoint))
      End If

      averagePointSpacing = Math.Sqrt(averageAreaPerPoint)

      Return averagePointSpacing
    End Function

    Private Function GetAverageAreaPerPoint(ByVal area As IArea, ByVal pointCount As Double) As Double
      Return area.Area / pointCount
    End Function

    Private Sub ValidateAveragePointSpacing(ByVal averagePointSpacing As Double)
      If averagePointSpacing <= 0 Then
        Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Invalid Average Point Spacing. averagePointSpacing <= 0." & ObjectToString.GetNewline() & "averagePointSpacing: " & ObjectToString.GetToString(averagePointSpacing))
      End If
    End Sub

    Private Function GetFeatureBuffer(ByVal gpOutputFeatureClass As IGPOutputFeatureClass, ByVal geometry As IGeometry, ByVal inputFile As IInputFile, ByVal pointCount As Double, ByVal averagePointSpacing As Double, ByVal xMin As Double, ByVal xMax As Double, ByVal yMin As Double, ByVal yMax As Double, ByVal zMin As Double, ByVal zMax As Double) As IFeatureBuffer
      Dim featureBuffer As IFeatureBuffer

      Try
        featureBuffer = gpOutputFeatureClass.FeatureClass.CreateFeatureBuffer()
      Catch ex As COMException
        Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Unable To Create Feature Buffer." & ObjectToString.GetNewline() & "gpOutputFeatureClass: " & ObjectToString.GetToString(gpOutputFeatureClass), ex)
      End Try

      Dim feature As IFeature = TryCast(featureBuffer, IFeature)

      SetShape(feature, geometry)

      SetField(feature, "FileName", inputFile.Name)
      SetField(feature, "PointCount", pointCount)
      SetField(feature, "AvgPtSpc", averagePointSpacing)
      SetField(feature, "XMin", xMin)
      SetField(feature, "XMax", xMax)
      SetField(feature, "YMin", yMin)
      SetField(feature, "YMax", yMax)
      SetField(feature, "ZMin", zMin)
      SetField(feature, "ZMax", zMax)

      Return featureBuffer
    End Function

    Private Sub SetShape(ByVal feature As IFeature, ByVal geometry As IGeometry)
      Try
        feature.Shape = geometry
      Catch ex As COMException
        Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Unable To Set Shape." & ObjectToString.GetNewline() & "feature: " & ObjectToString.GetToString(feature) & "geometry: " & ObjectToString.GetToString(geometry), ex)
      End Try
    End Sub

    Private Sub SetField(ByVal feature As IFeature, ByVal name As String, ByVal value As Object)
      Dim fields As IFields = feature.Fields

      Dim index As Integer = fields.FindField(name)

      Try
                feature.Value(index) = value
      Catch ex As COMException
        Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Unable To Set Field." & ObjectToString.GetNewline() & "feature: " & ObjectToString.GetToString(feature) & "name: " & ObjectToString.GetToString(name) & "value: " & ObjectToString.GetToString(value), ex)
      End Try
    End Sub

    Private Sub ValidateFeatureBuffer(ByVal featureBuffer As IFeatureBuffer)
      If featureBuffer Is Nothing Then
        Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Feature Buffer Is Null.")
      ElseIf featureBuffer.Shape Is Nothing Then
        Throw New GPException(GPExceptionSeverity.Warn, "Invalid Output Feature Buffer. Feature Buffer Shape Is Null." & ObjectToString.GetNewline() & "featureBuffer: " & ObjectToString.GetToString(featureBuffer))
      End If
    End Sub
  End Class
End Namespace