GPPointFileInfo\GPOutputFeatureClass.vb
Creating a non-trival custom GP tool - inputs, outputs, and responding to environment settings
GPPointFileInfo\GPOutputFeatureClass.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.Collections.Generic
Imports System.Collections
Imports System.Runtime.InteropServices
Imports System.Text.RegularExpressions
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.Geoprocessing
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.Geometry

Namespace GPPointFileInfo
  Public Class GPOutputFeatureClass
        Implements GPPointFileInfo.IGPOutputFeatureClass
    Private Shared _parameterIndex As Integer

    Private _featureClass As IFeatureClass

    Public Sub New(ByVal parameterValueArray As IParameterValueArray, ByVal gpInputFolder As IGPInputFolder, ByVal inputSpatialReference As ISpatialReference, ByVal outputSpatialReference As ISpatialReference, ByVal outputHasZ As IOutputHasZ, ByVal esOverwriteOutput As IESOverwriteOutput, ByVal esConfigKeyword As IESConfigKeyword, ByVal esScratchWorkspace As IESScratchWorkspace, ByVal esSpatialGrid1 As IESSpatialGrid1, ByVal esSpatialGrid2 As IESSpatialGrid2, ByVal esSpatialGrid3 As IESSpatialGrid3)
      Dim gpValue As IGPValue = parameterValueArray.GetGPValue(_parameterIndex)

      _featureClass = GetFeatureClass(gpValue, gpInputFolder, inputSpatialReference, outputSpatialReference, outputHasZ, esOverwriteOutput, esConfigKeyword, esScratchWorkspace, esSpatialGrid1, esSpatialGrid2, esSpatialGrid3)
    End Sub

        Public ReadOnly Property MinAvgPtSpc() As Double Implements IGPOutputFeatureClass.MinAvgPtSpc
            Get
                Return GetMinAvgPtSpc()
            End Get
        End Property

    Private Function GetMinAvgPtSpc() As Double
      Const InvalidMinAvgPtSpc As Double = -1
      Const FieldName As String = "AvgPtSpc"

      Dim minAvgPtSpc As Double

      Dim featureCount As Integer = _featureClass.FeatureCount(Nothing)

      If featureCount = 0 Then
        minAvgPtSpc = InvalidMinAvgPtSpc
      Else
        Dim featureCursor As IFeatureCursor = _featureClass.Search(Nothing, False)

        Dim cursor As ICursor = TryCast(featureCursor, ICursor)

        Dim dataStatistics As IDataStatistics = New DataStatisticsClass()

        dataStatistics.Field = FieldName
        dataStatistics.Cursor = cursor

        Dim statisticsResults As IStatisticsResults = dataStatistics.Statistics

        minAvgPtSpc = statisticsResults.Minimum
      End If

      Return minAvgPtSpc
    End Function

    Public Shared Function GetGPParameterEdit() As IGPParameterEdit
      Dim gpParameterEdit As IGPParameterEdit = New GPParameterClass()

      Dim gpDataType As IGPDataType = New DEFeatureClassTypeClass()

      Dim gpValue As IGPValue = New DEFeatureClassClass()

      gpParameterEdit.Name = "out_output_feature_class"
      gpParameterEdit.DisplayName = "Output Feature Class"
      gpParameterEdit.DataType = gpDataType
      gpParameterEdit.Value = gpValue
      gpParameterEdit.Direction = esriGPParameterDirection.esriGPParameterDirectionOutput
      gpParameterEdit.ParameterType = esriGPParameterType.esriGPParameterTypeRequired

      Return gpParameterEdit
    End Function

    Public Shared Sub SetGPParameterIndex(ByVal index As Integer)
      _parameterIndex = index
    End Sub

        Public ReadOnly Property FeatureClass() As IFeatureClass Implements IGPOutputFeatureClass.FeatureClass
            Get
                Return _featureClass
            End Get
        End Property

    Private Function GetFeatureClass(ByVal gpValue As IGPValue, ByVal gpInputFolder As IGPInputFolder, ByVal inputSpatialReference As ISpatialReference, ByVal outputSpatialReference As ISpatialReference, ByVal outputHasZ As IOutputHasZ, ByVal esOverwriteOutput As IESOverwriteOutput, ByVal esConfigKeyword As IESConfigKeyword, ByVal esScratchWorkspace As IESScratchWorkspace, ByVal esSpatialGrid1 As IESSpatialGrid1, ByVal esSpatialGrid2 As IESSpatialGrid2, ByVal esSpatialGrid3 As IESSpatialGrid3) As IFeatureClass
      Const FeatureType As esriFeatureType = esriFeatureType.esriFTSimple

      Dim featureClass As IFeatureClass

      Dim featureClassNameAsText As String = GetFeatureClassNameAsText(gpValue)

      Dim featureClassPath As String = GetFeatureClassPath(gpValue, gpInputFolder, esScratchWorkspace)

      gpValue = GetGPValue(featureClassPath, featureClassNameAsText)

      Dim gpUtilities As IGPUtilities = New GPUtilitiesClass()

      If gpUtilities.Exists(gpValue) Then
        If esOverwriteOutput.Value = False Then
          Throw New GPException(GPExceptionSeverity.Error, "Invalid Output Feature Class. Output Feature Class Already Exists.")
        Else
          Dim dataset As IDataset

          Try
            dataset = gpUtilities.OpenDataset(gpValue)
          Catch ex As COMException
            Throw New GPException(GPExceptionSeverity.Error, "Invalid Output Feature Class. Output Feature Class Cannot Be Opened." & ObjectToString.GetToString(gpValue), ex)
          End Try

          If (Not dataset.CanDelete()) Then
            Throw New GPException(GPExceptionSeverity.Error, "Invalid Output Feature Class. Output Feature Class Cannot Be Deleted. Feature Class May Be Participating In A Controller Dataset: Terrain, Topology, Or Network." & ObjectToString.GetToString(dataset))
          Else
            gpUtilities.Delete(gpValue)
          End If
        End If
      End If

      Dim featureClassName As IFeatureClassName = GetFeatureClassName(gpValue)

      Dim featureClassDescriptionClass As FeatureClassDescriptionClass = New FeatureClassDescriptionClass()

      Dim featureClassDescription As IFeatureClassDescription = TryCast(featureClassDescriptionClass, IFeatureClassDescription)

      Dim objectClassDescription As IObjectClassDescription = TryCast(featureClassDescription, IObjectClassDescription)

      Dim fields As IFields = GetFields(featureClassNameAsText, objectClassDescription, inputSpatialReference, outputSpatialReference, outputHasZ, esSpatialGrid1, esSpatialGrid2, esSpatialGrid3)

      If IsFeatureClassInFeatureDataset(featureClassName) Then
        featureClass = GetFeatureClassFromFeatureDataset(featureClassName, featureClassNameAsText, fields, featureClassDescription, objectClassDescription, FeatureType, esConfigKeyword)
      Else
        featureClass = GetFeatureClassFromFeatureWorkspace(featureClassName, featureClassNameAsText, fields, featureClassDescription, objectClassDescription, FeatureType, esConfigKeyword)
      End If

      Return featureClass
    End Function

    Private Function GetFeatureClassName(ByVal gpValue As IGPValue) As IFeatureClassName
      Dim featureClassName As IFeatureClassName

      Dim gpUtilities As IGPUtilities = New GPUtilitiesClass()

      Dim dataElement As IDataElement = TryCast(gpValue, IDataElement)

      Dim name As IName = gpUtilities.CreateFeatureClassName(dataElement.CatalogPath)

      featureClassName = TryCast(name, IFeatureClassName)

      Return featureClassName
    End Function

    Private Function GetFeatureClassNameAsText(ByVal gpValue As IGPValue) As String
      Dim featureClassNameAsText As String

      Dim dataElement As IDataElement = TryCast(gpValue, IDataElement)

      featureClassNameAsText = dataElement.Name

      Return featureClassNameAsText
    End Function

    Private Function GetFeatureClassPath(ByVal gpValue As IGPValue, ByVal gpInputFolder As IGPInputFolder, ByVal esScratchWorkspace As IESScratchWorkspace) As String
      Dim featureClassPath As String

      Dim featureClassPathFromGPValue As String = GetFeatureClassPath(gpValue)
      Dim featureClassPathFromScratchWorkspace As String = GetFeatureClassPath(esScratchWorkspace)
      Dim featureClassPathFromIGPInputFolder As String = GetFeatureClassPath(gpInputFolder)

      If IsBlank(featureClassPathFromGPValue) Then
        If IsBlank(featureClassPathFromScratchWorkspace) Then
          featureClassPath = featureClassPathFromIGPInputFolder
        Else
          featureClassPath = featureClassPathFromScratchWorkspace
        End If
      Else
        featureClassPath = featureClassPathFromGPValue
      End If

      Return featureClassPath
    End Function

    Private Function IsBlank(ByVal text As String) As Boolean
      Const Pattern As String = "^\s*$"

            Dim blnIsBlank As Boolean

      Dim regex As Regex = New Regex(Pattern)

            blnIsBlank = regex.IsMatch(text)

            Return blnIsBlank
    End Function

    Private Function GetFeatureClassPath(ByVal gpValue As IGPValue) As String
      Dim featureClassPath As String

      Dim dataElement As IDataElement = TryCast(gpValue, IDataElement)

      featureClassPath = dataElement.GetPath()

      Return featureClassPath
    End Function

    Private Function GetFeatureClassPath(ByVal esScratchWorkspace As IESScratchWorkspace) As String
      Return esScratchWorkspace.Path
    End Function

    Private Function GetFeatureClassPath(ByVal gpInputFolder As IGPInputFolder) As String
      Return gpInputFolder.Folder
    End Function

    Private Function GetGPValue(ByVal featureClassPath As String, ByVal featureClassNameAsText As String) As IGPValue
      Dim gpValue As IGPValue

      Dim gpDataType As IGPDataType = New DEFeatureClassTypeClass()

      gpValue = gpDataType.CreateValue(featureClassPath & "\" & featureClassNameAsText)

      Return gpValue
    End Function

    Private Function GetFields(ByVal featureClassNameAsText As String, ByVal objectClassDescription As IObjectClassDescription, ByVal inputSpatialReference As ISpatialReference, ByVal outputSpatialReference As ISpatialReference, ByVal outputHasZ As IOutputHasZ, ByVal esSpatialGrid1 As IESSpatialGrid1, ByVal esSpatialGrid2 As IESSpatialGrid2, ByVal esSpatialGrid3 As IESSpatialGrid3) As IFields
      Dim fields As IFields = New FieldsClass()

      Dim fieldsEdit As IFieldsEdit = TryCast(fields, IFieldsEdit)

      Dim requiredFields As IFields = GetRequiredFields(featureClassNameAsText, objectClassDescription, inputSpatialReference, outputSpatialReference, outputHasZ, esSpatialGrid1, esSpatialGrid2, esSpatialGrid3)

      Dim i As Integer = 0
      Do While i < requiredFields.FieldCount
                Dim requiredField As IField = requiredFields.Field(i)

        fieldsEdit.AddField(requiredField)
        i += 1
      Loop

      Dim fieldsDictionary As Dictionary(Of String, esriFieldType) = GetFieldsDictionary()

      Dim dictionaryEnumerator As IDictionaryEnumerator = fieldsDictionary.GetEnumerator()

      Dim isElement As Boolean = dictionaryEnumerator.MoveNext()

      Do While isElement
        Dim field As IField = GetField(dictionaryEnumerator.Entry)

        fieldsEdit.AddField(field)

        isElement = dictionaryEnumerator.MoveNext()
      Loop

      Return fields
    End Function

    Private Function GetRequiredFields(ByVal featureClassNameAsText As String, ByVal objectClassDescription As IObjectClassDescription, ByVal inputSpatialReference As ISpatialReference, ByVal outputSpatialReference As ISpatialReference, ByVal outputHasZ As IOutputHasZ, ByVal esSpatialGrid1 As IESSpatialGrid1, ByVal esSpatialGrid2 As IESSpatialGrid2, ByVal esSpatialGrid3 As IESSpatialGrid3) As IFields
      Dim requiredFields As IFields = New FieldsClass()

      Dim requiredFieldsEdit As IFieldsEdit = TryCast(requiredFields, IFieldsEdit)

      Dim i As Integer = 0
      Do While i < objectClassDescription.RequiredFields.FieldCount
                Dim requiredField As IField = objectClassDescription.RequiredFields.Field(i)

        If IsShapeField(requiredField) Then
          requiredField = GetShapeField(requiredField, inputSpatialReference, outputSpatialReference, outputHasZ, esSpatialGrid1, esSpatialGrid2, esSpatialGrid3)
        End If

        requiredFieldsEdit.AddField(requiredField)
        i += 1
      Loop

      Return requiredFields
    End Function

    Private Function IsShapeField(ByVal field As IField) As Boolean
      Const ShapeFieldName As String = "SHAPE"

      Return (field.Name = ShapeFieldName)
    End Function

    Private Function GetShapeField(ByVal field As IField, ByVal inputSpatialReference As ISpatialReference, ByVal outputSpatialReference As ISpatialReference, ByVal outputHasZ As IOutputHasZ, ByVal esSpatialGrid1 As IESSpatialGrid1, ByVal esSpatialGrid2 As IESSpatialGrid2, ByVal esSpatialGrid3 As IESSpatialGrid3) As IField
      Dim shapeField As IField = field

      Dim shapeFieldEdit As IFieldEdit = TryCast(shapeField, IFieldEdit)

      shapeFieldEdit.GeometryDef_2 = GetGeometryDef(inputSpatialReference, outputSpatialReference, outputHasZ, esSpatialGrid1, esSpatialGrid2, esSpatialGrid3)

      Return shapeField
    End Function

    Private Function GetGeometryDef(ByVal inputSpatialReference As ISpatialReference, ByVal outputSpatialReference As ISpatialReference, ByVal outputHasZ As IOutputHasZ, ByVal esSpatialGrid1 As IESSpatialGrid1, ByVal esSpatialGrid2 As IESSpatialGrid2, ByVal esSpatialGrid3 As IESSpatialGrid3) As IGeometryDef
      Const HasM As Boolean = False

      Dim geometryDef As IGeometryDef = New GeometryDefClass()

      Dim geometryDefEdit As IGeometryDefEdit = TryCast(geometryDef, IGeometryDefEdit)

      Dim geometryType As esriGeometryType = GetGeometryType(outputHasZ)

      geometryDefEdit.GeometryType_2 = geometryType
      geometryDefEdit.HasZ_2 = outputHasZ.HasZ
      geometryDefEdit.HasM_2 = HasM
      geometryDefEdit.SpatialReference_2 = GetSpatialReference(inputSpatialReference, outputSpatialReference)
      geometryDefEdit.GridCount_2 = 3

      Try
                geometryDefEdit.GridSize_2(0) = esSpatialGrid1.Value
      Catch ex As COMException
        Throw New GPException(GPExceptionSeverity.Error, "Invalid Output Feature Class. Unable To Set Grid Size On Geometry Def Edit. index = 0" & ObjectToString.GetNewline() & "esSpatialGrid1: " & ObjectToString.GetToString(esSpatialGrid1), ex)
      End Try

      Try
                geometryDefEdit.GridSize_2(1) = esSpatialGrid2.Value
      Catch ex As COMException
        Throw New GPException(GPExceptionSeverity.Error, "Invalid Output Feature Class. Unable To Set Grid Size On Geometry Def Edit. index = 1" & ObjectToString.GetNewline() & "esSpatialGrid2: " & ObjectToString.GetToString(esSpatialGrid2), ex)
      End Try

      Try
                geometryDefEdit.GridSize_2(2) = esSpatialGrid3.Value
      Catch ex As COMException
        Throw New GPException(GPExceptionSeverity.Error, "Invalid Output Feature Class. Unable To Set Grid Size On Geometry Def Edit. index = 2" & ObjectToString.GetNewline() & "esSpatialGrid3: " & ObjectToString.GetToString(esSpatialGrid3), ex)
      End Try

      Return geometryDef
    End Function

    Private Function GetSpatialReference(ByVal inputSpatialReference As ISpatialReference, ByVal outputSpatialReference As ISpatialReference) As ESRI.ArcGIS.Geometry.ISpatialReference
      If (((Not inputSpatialReference.IsUnknown)) AndAlso (outputSpatialReference.IsUnknown)) Then
        Return inputSpatialReference.SpatialReference
      Else
        Return outputSpatialReference.SpatialReference
      End If
    End Function

    Private Function GetGeometryType(ByVal outputHasZ As IOutputHasZ) As esriGeometryType
      If outputHasZ.HasZ Then
        Return esriGeometryType.esriGeometryMultiPatch
      Else
        Return esriGeometryType.esriGeometryPolygon
      End If
    End Function

    Private Function GetFieldsDictionary() As Dictionary(Of String, esriFieldType)
      Dim fieldsDictionary As Dictionary(Of String, esriFieldType) = New Dictionary(Of String, esriFieldType)()

      fieldsDictionary.Add("FileName", esriFieldType.esriFieldTypeString)
      fieldsDictionary.Add("PointCount", esriFieldType.esriFieldTypeDouble)
      fieldsDictionary.Add("AvgPtSpc", esriFieldType.esriFieldTypeDouble)
      fieldsDictionary.Add("XMin", esriFieldType.esriFieldTypeDouble)
      fieldsDictionary.Add("XMax", esriFieldType.esriFieldTypeDouble)
      fieldsDictionary.Add("YMin", esriFieldType.esriFieldTypeDouble)
      fieldsDictionary.Add("YMax", esriFieldType.esriFieldTypeDouble)
      fieldsDictionary.Add("ZMin", esriFieldType.esriFieldTypeDouble)
      fieldsDictionary.Add("ZMax", esriFieldType.esriFieldTypeDouble)

      Return fieldsDictionary
    End Function

    Private Function GetField(ByVal dictionaryEntry As DictionaryEntry) As IField
      Dim field As IField = New FieldClass()

      Dim fieldEdit As IFieldEdit = TryCast(field, IFieldEdit)

      fieldEdit.Name_2 = TryCast(dictionaryEntry.Key, String)
      fieldEdit.Type_2 = CType(dictionaryEntry.Value, esriFieldType)

      Return field
    End Function

    Private Function IsFeatureClassInFeatureDataset(ByVal featureClassName As IFeatureClassName) As Boolean
      Return (Not featureClassName.FeatureDatasetName Is Nothing)
    End Function

    Private Function GetFeatureClassFromFeatureDataset(ByVal featureClassName As IFeatureClassName, ByVal featureClassNameAsText As String, ByVal fields As IFields, ByVal featureClassDescription As IFeatureClassDescription, ByVal objectClassDescription As IObjectClassDescription, ByVal featureType As esriFeatureType, ByVal esConfigKeyword As IESConfigKeyword) As IFeatureClass
      Dim featureClass As IFeatureClass

      Dim datasetName As IDatasetName = featureClassName.FeatureDatasetName

      Dim name As IName = TryCast(datasetName, IName)

      Dim fixedFields As IFields = GetFixedFieldsFromFeatureDataset(name, fields)

      Dim openedName As Object = name.Open()

      Dim featureDataset As IFeatureDataset = TryCast(openedName, IFeatureDataset)

      Try
        featureClass = featureDataset.CreateFeatureClass(featureClassNameAsText, fixedFields, objectClassDescription.InstanceCLSID, objectClassDescription.ClassExtensionCLSID, featureType, featureClassDescription.ShapeFieldName, esConfigKeyword.Value)
      Catch ex As COMException
        Throw New GPException(GPExceptionSeverity.Error, "Invalid Output Feature Class. Unable To Create Feature Class In Feature Dataset." & ObjectToString.GetNewline() & "featureDataset: " & ObjectToString.GetToString(featureDataset) & "featureClassNameAsText: " & ObjectToString.GetToString(featureClassNameAsText) & "fixedFields: " & ObjectToString.GetToString(fixedFields) & "objectClassDescription: " & ObjectToString.GetToString(objectClassDescription) & "featureType: " & ObjectToString.GetToString(featureType) & "featureClassDescription: " & ObjectToString.GetToString(featureClassDescription) & "esConfigKeyword: " & ObjectToString.GetToString(esConfigKeyword), ex)
      End Try

      Return featureClass
    End Function

    Private Function GetFixedFieldsFromFeatureDataset(ByVal name As IName, ByVal fields As IFields) As IFields
            Dim fixedFields As IFields = Nothing

      Dim openedName As Object = name.Open()

      Dim featureDataset As IFeatureDataset = TryCast(openedName, IFeatureDataset)

      Dim workspace As IWorkspace = featureDataset.Workspace

      Dim fieldChecker As IFieldChecker = New FieldCheckerClass()

      fieldChecker.ValidateWorkspace = workspace

            Dim enumFieldError As IEnumFieldError = Nothing

            fieldChecker.Validate(fields, enumFieldError, fixedFields)

      Return fixedFields
    End Function

    Private Function GetFeatureClassFromFeatureWorkspace(ByVal featureClassName As IFeatureClassName, ByVal featureClassNameAsText As String, ByVal fields As IFields, ByVal featureClassDescription As IFeatureClassDescription, ByVal objectClassDescription As IObjectClassDescription, ByVal featureType As esriFeatureType, ByVal esConfigKeyword As IESConfigKeyword) As IFeatureClass
      Dim featureClass As IFeatureClass

      Dim datasetName As IDatasetName = TryCast(featureClassName, IDatasetName)

      Dim workspaceName As IWorkspaceName = datasetName.WorkspaceName

      Dim name As IName = TryCast(workspaceName, IName)

      Dim fixedFields As IFields = GetFixedFieldsFromFeatureWorkspace(name, fields)

      Dim openedName As Object = name.Open()

      Dim workspace As IWorkspace = TryCast(openedName, IWorkspace)

      Dim featureWorkspace As IFeatureWorkspace = TryCast(workspace, IFeatureWorkspace)

      Try
        featureClass = featureWorkspace.CreateFeatureClass(featureClassNameAsText, fields, objectClassDescription.InstanceCLSID, objectClassDescription.ClassExtensionCLSID, featureType, featureClassDescription.ShapeFieldName, esConfigKeyword.Value)
      Catch ex As COMException
        Throw New GPException(GPExceptionSeverity.Error, "Invalid Output Feature Class. Unable To Create Feature Class In Feature Workspace." & ObjectToString.GetNewline() & "featureWorkspace: " & ObjectToString.GetToString(featureWorkspace) & "featureClassNameAsText: " & ObjectToString.GetToString(featureClassNameAsText) & "fixedFields: " & ObjectToString.GetToString(fixedFields) & "objectClassDescription: " & ObjectToString.GetToString(objectClassDescription) & "featureType: " & ObjectToString.GetToString(featureType) & "featureClassDescription: " & ObjectToString.GetToString(featureClassDescription) & "esConfigKeyword: " & ObjectToString.GetToString(esConfigKeyword), ex)
      End Try

      Return featureClass
    End Function

    Private Function GetFixedFieldsFromFeatureWorkspace(ByVal name As IName, ByVal fields As IFields) As IFields
            Dim fixedFields As IFields = Nothing

      Dim openedName As Object = name.Open()

      Dim workspace As IWorkspace = TryCast(openedName, IWorkspace)

      Dim fieldChecker As IFieldChecker = New FieldCheckerClass()

      fieldChecker.ValidateWorkspace = workspace

            Dim enumFieldError As IEnumFieldError = Nothing

      fieldChecker.Validate(fields, enumFieldError, fixedFields)

      Return fixedFields
    End Function
  End Class
End Namespace