Building a custom geoprocessing function tool (Calculate Area)
GPCalculateArea\CalculateAreaFunction.vb
' Copyright 2007 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 the use restrictions.
'
Imports Microsoft.VisualBasic
Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.Runtime.InteropServices
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.Geometry
Imports ESRI.ArcGIS.Geoprocessing
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.DataSourcesFile
Imports ESRI.ArcGIS.DataSourcesGDB
Imports ESRI.ArcGIS.ADF.CATIDs
Namespace GPCalculateArea
Public Class CalculateAreaFunction : Implements IGPFunction
' Local members
Private m_ToolName As String = "CalculateArea" 'Function Name
Private m_MetaDataFile As String = "CalculateArea_area.xml" 'Metadata file
Private m_Parameters As IArray ' Array of Parameters
Private m_GPUtilities As New GPUtilities ' GPUtilities object
#Region "IGPFunction Members"
' Set the name of the function tool.
' This name appears when executing the tool at the command line or in scripting.
' This name should be unique to each toolbox and must not contain spaces.
Public ReadOnly Property Name() As String Implements IGPFunction.Name
Get
Return m_ToolName
End Get
End Property
' Set the function tool Display Name as seen in ArcToolbox.
Public ReadOnly Property DisplayName() As String Implements IGPFunction.DisplayName
Get
Return "Calculate Area"
End Get
End Property
' This is the location where the parameters to the Function Tool are defined.
' This property returns an IArray of parameter objects (IGPParameter).
' These objects define the characteristics of the input and output parameters.
Public ReadOnly Property ParameterInfo() As IArray Implements IGPFunction.ParameterInfo
Get
'Array to the hold the parameters
Dim pParameters As IArray = New ArrayClass()
'Input DataType is GPFeatureLayerType
Dim inputParameter As IGPParameterEdit = New GPParameterClass()
inputParameter.DataType = New GPFeatureLayerTypeClass()
' Default Value object is DEFeatureClass
inputParameter.Value = New GPFeatureLayerClass()
' Set Input Parameter properties
inputParameter.Direction = esriGPParameterDirection.esriGPParameterDirectionInput
inputParameter.DisplayName = "Input Features"
inputParameter.Name = "input_features"
inputParameter.ParameterType = esriGPParameterType.esriGPParameterTypeRequired
pParameters.Add(inputParameter)
' Area field parameter
inputParameter = New GPParameterClass()
inputParameter.DataType = New GPStringTypeClass()
' Value object is GPString
Dim gpStringValue As IGPString = New GPStringClass()
gpStringValue.Value = "Area"
inputParameter.Value = CType(gpStringValue, IGPValue)
' Set field name parameter properties
inputParameter.Direction = esriGPParameterDirection.esriGPParameterDirectionInput
inputParameter.DisplayName = "Area Field Name"
inputParameter.Name = "field_name"
inputParameter.ParameterType = esriGPParameterType.esriGPParameterTypeRequired
pParameters.Add(inputParameter)
' Output parameter (Derived) and data type is DEFeatureClass
Dim outputParameter As IGPParameterEdit = New GPParameterClass()
outputParameter.DataType = New GPFeatureLayerTypeClass()
' Value object is DEFeatureClass
outputParameter.Value = New GPFeatureLayerClass()
' Set output parameter properties
outputParameter.Direction = esriGPParameterDirection.esriGPParameterDirectionOutput
outputParameter.DisplayName = "Output FeatureClass"
outputParameter.Name = "out_featureclass"
outputParameter.ParameterType = esriGPParameterType.esriGPParameterTypeDerived
pParameters.Add(outputParameter)
Return pParameters
End Get
End Property
' Validate: This will validate each parameter and return messages.
' This method will check that a given set of parameter values are of the
' appropriate number, DataType, and Value.
Public Function Validate(ByVal paramvalues As IArray, ByVal updateValues As Boolean, ByVal envMgr As IGPEnvironmentManager) As IGPMessages Implements IGPFunction.Validate
If m_Parameters Is Nothing Then
m_Parameters = ParameterInfo()
End If
' Call InternalValidate (Basic Validation). Are all the required parameters supplied?
' Are the Values to the parameters the correct data type?
Dim validateMsgs As IGPMessages = m_GPUtilities.InternalValidate(m_Parameters, paramvalues, updateValues, True, envMgr)
' Check for error messages
If validateMsgs.MaxSeverity = esriGPMessageSeverity.esriGPMessageSeverityError Then
Return validateMsgs
End If
' Clone the input parameter value
Dim parameter As IGPParameter = CType(paramvalues.Element(0), IGPParameter)
Dim parameterValue As IGPValue = m_GPUtilities.UnpackGPValue(parameter)
Dim parameterClone As IClone = CType(parameterValue, IClone)
Dim outputValue As IGPValue = CType(parameterClone.Clone(), IGPValue)
Dim inputTable As IDETable = m_GPUtilities.DecodeDETable(outputValue)
' Add the Area field to the Output Value
parameter = CType(paramvalues.Element(1), IGPParameter)
Dim sField As String = parameter.Value.GetAsText()
If Not inputTable Is Nothing Then
Dim areaField As IField = m_GPUtilities.FindField(outputValue, sField)
If areaField Is Nothing Then
Dim fieldsEdit As IFieldsEdit = CType(inputTable.Fields, IFieldsEdit)
Dim fieldEdit As IFieldEdit = New FieldClass()
fieldEdit.Name_2 = sField
fieldEdit.Type_2 = esriFieldType.esriFieldTypeDouble
fieldsEdit.AddField(fieldEdit)
inputTable.Fields = fieldsEdit
End If
parameter = CType(paramvalues.Element(2), IGPParameter)
m_GPUtilities.PackGPValue(outputValue, parameter)
End If
Return validateMsgs
End Function
' Execute: Execute the function given the array of the parameters
Public Sub Execute(ByVal paramvalues As IArray, ByVal trackcancel As ITrackCancel, ByVal envMgr As IGPEnvironmentManager, ByVal message As IGPMessages) Implements IGPFunction.Execute
' Call InternalValidate
Dim validateMessages As IGPMessages = m_GPUtilities.InternalValidate(m_Parameters, paramvalues, False, False, envMgr)
' Check for error messages
Dim gpmessage As IGPMessage = CType(validateMessages, IGPMessage)
If (Not gpmessage.IsError()) Then
' Get the first Input Parameter
Dim parameter As IGPParameter = CType(paramvalues.Element(0), IGPParameter)
' UnPackGPValue. This ensures you get the value either form the dataelement or GpVariable (modelbuilder)
Dim parameterValue As IGPValue = m_GPUtilities.UnpackGPValue(parameter)
' Open Input Feature Class
Dim inputFeatureClass As IFeatureClass
Dim qf As IQueryFilter
m_GPUtilities.DecodeFeatureLayer(parameterValue, inputFeatureClass, qf)
If inputFeatureClass Is Nothing Then
message.AddError(2, "Could not open input dataset.")
Return
End If
' Add the field if it does not exist.
Dim indexA As Integer
parameter = CType(paramvalues.Element(1), IGPParameter)
Dim sField As String = parameter.Value.GetAsText()
indexA = inputFeatureClass.FindField(sField)
If indexA < 0 Then
Dim fieldEdit As IFieldEdit = New FieldClass()
fieldEdit.Type_2 = esriFieldType.esriFieldTypeDouble
fieldEdit.Name_2 = sField
message.AddMessage(sField)
inputFeatureClass.AddField(fieldEdit)
End If
' Create an Update Cursor
indexA = inputFeatureClass.FindField(sField)
Dim updateCursor As IFeatureCursor = inputFeatureClass.Update(Nothing, False)
Dim updateFeature As IFeature = updateCursor.NextFeature()
Dim geometry As IGeometry
Dim area As IArea
Dim dArea As Double
Do While Not updateFeature Is Nothing
geometry = updateFeature.Shape
area = CType(geometry, IArea)
dArea = area.Area
updateFeature.Value(indexA) = dArea
updateCursor.UpdateFeature(updateFeature)
updateFeature.Store()
updateFeature = updateCursor.NextFeature()
Loop
End If
End Sub
' This is the function name object for the Geoprocessing Function Tool.
' This name object is created and returned by the Function Factory.
' The Function Factory must first be created before implementing this property.
Public ReadOnly Property FullName() As IName Implements IGPFunction.FullName
Get
' Add CalculateArea.FullName getter implementation
Dim functionFactory As IGPFunctionFactory = New CalculateAreaFunctionFactory()
'INSTANT VB NOTE: The local variable name was renamed since Visual Basic will not uniquely identify class members when local variables have the same name:
Return CType(functionFactory.GetFunctionName(m_ToolName), IName)
End Get
End Property
' This is used to set a custom renderer for the output of the Function Tool.
Public Function GetRenderer(ByVal pParam As IGPParameter) As Object Implements IGPFunction.GetRenderer
Return Nothing
End Function
' This is the unique context identifier in a [MAP] file (.h).
' ESRI Knowledge Base article #27680 provides more information about creating a [MAP] file.
Public ReadOnly Property HelpContext() As Integer Implements IGPFunction.HelpContext
Get
Return 0
End Get
End Property
' This is the path to a .chm file which is used to describe and explain the function and its operation.
Public ReadOnly Property HelpFile() As String Implements IGPFunction.HelpFile
Get
Return ""
End Get
End Property
' This is used to return whether the function tool is licensed to execute.
Public Function IsLicensed() As Boolean Implements IGPFunction.IsLicensed
Return True
End Function
' This is the name of the (.xml) file containing the default metadata for this function tool.
' The metadata file is used to supply the parameter descriptions in the help panel in the dialog.
' If no (.chm) file is provided, the help is based on the metadata file.
' ESRI Knowledge Base article #27000 provides more information about creating a metadata file.
Public ReadOnly Property MetadataFile() As String Implements IGPFunction.MetadataFile
Get
Return m_MetaDataFile
End Get
End Property
' This is the class id used to override the default dialog for a tool.
' By default, the Toolbox will create a dialog based upon the parameters returned
' by the ParameterInfo property.
Public ReadOnly Property DialogCLSID() As UID Implements IGPFunction.DialogCLSID
Get
Return Nothing
End Get
End Property
#End Region
End Class
'////////////////////////////
' Function Factory Class
'//////////////////////////
<Guid("2554BFC7-94F9-4d28-B3FE-14D17599B35A"), ComVisible(True)> _
Public Class CalculateAreaFunctionFactory : Implements IGPFunctionFactory
Private m_GPFunction As IGPFunction
' Register the Function Factory with the ESRI Geoprocessor Function Factory Component Category.
#region "Component Category Registration"
<ComRegisterFunction()> _
Private Shared Sub Reg(ByVal regKey As String)
GPFunctionFactories.Register(regKey)
End Sub
<ComUnregisterFunction()> _
Private Shared Sub Unreg(ByVal regKey As String)
GPFunctionFactories.Unregister(regKey)
End Sub
#End Region
' Utility Function added to create the function names.
Private Function CreateGPFunctionNames(ByVal index As Long) As IGPFunctionName
Dim functionName As IGPFunctionName = New GPFunctionNameClass()
'INSTANT VB NOTE: The local variable name was renamed since Visual Basic will not uniquely identify class members when local variables have the same name:
Dim name_Renamed As IGPName
Select Case index
Case (0)
name_Renamed = CType(functionName, IGPName)
name_Renamed.Category = "AreaCalculation"
name_Renamed.Description = "Calculate Area for FeatureClass"
name_Renamed.DisplayName = "Calculate Area"
name_Renamed.Name = "CalculateArea"
name_Renamed.Factory = Me
End Select
Return functionName
End Function
' Implementation of the Function Factory
#Region "IGPFunctionFactory Members"
' This is the name of the function factory.
' This is used when generating the Toolbox containing the function tools of the factory.
Public ReadOnly Property Name() As String Implements IGPFunctionFactory.Name
Get
Return "AreaCalculation"
End Get
End Property
' This is the alias name of the factory.
Public ReadOnly Property [Alias]() As String Implements IGPFunctionFactory.Alias
Get
Return "area"
End Get
End Property
' This is the class id of the factory.
Public ReadOnly Property CLSID() As UID Implements IGPFunctionFactory.CLSID
Get
Dim id As UID = New UIDClass()
id.Value = Me.GetType().GUID.ToString("B")
Return id
End Get
End Property
' This method will create and return a function object based upon the input name.
Public Function GetFunction(ByVal Name As String) As IGPFunction Implements IGPFunctionFactory.GetFunction
Select Case Name
Case ("CalculateArea")
m_GPFunction = New CalculateAreaFunction()
End Select
Return m_GPFunction
End Function
' This method will create and return a function name object based upon the input name.
Public Function GetFunctionName(ByVal Name As String) As IGPName Implements IGPFunctionFactory.GetFunctionName
Dim gpName As IGPName = New GPFunctionNameClass()
Select Case Name
Case ("CalculateArea")
Return CType(CreateGPFunctionNames(0), IGPName)
End Select
Return gpName
End Function
' This method will create and return an enumeration of function names that the factory supports.
Public Function GetFunctionNames() As IEnumGPName Implements IGPFunctionFactory.GetFunctionNames
' Add CalculateFunctionFactory.GetFunctionNames implementation
Dim nameArray As IArray = New EnumGPNameClass()
nameArray.Add(CreateGPFunctionNames(0))
Return CType(nameArray, IEnumGPName)
End Function
' This method will create and return an enumeration of GPEnvironment objects.
' If tools published by this function factory required new environment settings,
'then you would define the additional environment settings here.
' This would be similar to how parameters are defined.
Public Function GetFunctionEnvironments() As IEnumGPEnvironment Implements IGPFunctionFactory.GetFunctionEnvironments
Return Nothing
End Function
#End Region
End Class
End Namespace