VegUtils_VBNet

VegUtils_VBNet.cs

VegUtils_VBNet.vb

Imports Microsoft.VisualBasic
Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.EnterpriseServices
Imports ESRI.ArcGIS.Carto
Imports ESRI.ArcGIS.Display
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.Geometry

<Guid("7B9FA6DD-C89E-40f2-85B2-1A8391D70568")> _
Public Interface IVegUtils_VBNet
  Function sumVegetationType(ByRef pVegClass As IFeatureClass, ByRef pPoint As IPoint, ByRef dDistance As Double, ByRef sSummaryFld As String) As IVegResults_VBNet
End Interface

Namespace VegCOM_VBNet
  <AutomationProxy(True), ClassInterface(ClassInterfaceType.None), Guid("FD32CC24-6547-48d8-B1D6-323E07F6269F")> _
  Public Class VegUtils_VBNet
    Inherits ServicedComponent
    Implements IVegUtils_VBNet
    Public Function sumVegetationType(ByRef pVegClass As IFeatureClass, ByRef pPoint As IPoint, ByRef dDistance As Double, ByRef sSummaryFld As String) As IVegResults_VBNet Implements IVegUtils_VBNet.sumVegetationType
      ' buffer the point
      Dim pTopoOp As ITopologicalOperator = TryCast(pPoint, ITopologicalOperator)
      Dim pGeom As IGeometry = pTopoOp.Buffer(dDistance)

      ' query the feature class
      Dim pSFilter As ISpatialFilter = New SpatialFilter()
      pSFilter.Geometry = pGeom
      pSFilter.SpatialRel = esriSpatialRelEnum.esriSpatialRelIntersects
      pSFilter.GeometryField = pVegClass.ShapeFieldName

      Dim pFCursor As IFeatureCursor = pVegClass.Search(pSFilter, True)

      ' loop thourgh the features, clip each geometry to the buffer
      ' and total areas by attribute value
      pTopoOp = TryCast(pGeom, ITopologicalOperator)
      Dim lPrim As Integer = pVegClass.FindField(sSummaryFld)

      Dim dict As New System.Collections.Specialized.ListDictionary()

      ' create the symbol and graphic elements collection for the graphics
      Dim pSFS As ISimpleFillSymbol = newFillS()
      Dim pGraphics As IGraphicElements = New GraphicElements()

      Dim pFeature As IFeature
      pFeature = pFCursor.NextFeature()
      Do While pFeature IsNot Nothing
        ' create the graphic
        Dim pFE As IFillShapeElement = TryCast(New PolygonElement, IFillShapeElement)
        Dim pElement As IElement = TryCast(pFE, IElement)

        ' clip the geometry
        Dim pNewGeom As IGeometry = pTopoOp.Intersect(pFeature.Shape, esriGeometryDimension.esriGeometry2Dimension)
        pElement.Geometry = pNewGeom
        pFE.Symbol = pSFS
        Dim ge As IGraphicElement = TryCast(pFE, IGraphicElement)
        pGraphics.Add(ge)

        ' add to dictionary
        Dim pArea As IArea = TryCast(pNewGeom, IArea)
        Dim sType As String = TryCast(pFeature.Value(lPrim), String)
        If dict.Contains(sType) Then
          dict(sType) = CDbl(dict(sType)) + pArea.Area
        Else
          dict(sType) = pArea.Area
        End If
        pFeature = pFCursor.NextFeature()
      Loop

      ' create the summary recordset
      Dim psumRS As IRecordSet = sumRS(dict)

      ' create the results object
      Dim pRes As IVegResults_VBNet = New VegResults_VBNet()
      pRes.ResGraphics = pGraphics
      pRes.Stats = psumRS

      Return pRes
    End Function

    Private Function sumRS(ByVal dict As System.Collections.Specialized.ListDictionary) As IRecordSet
      ' create the new record set
      Dim pNewRs As IRecordSet = New RecordSet()
      Dim prsInit As IRecordSetInit = TryCast(pNewRs, IRecordSetInit)

      Dim pFields As IFields = New Fields()
      Dim pFieldsEdit As IFieldsEdit = TryCast(pFields, IFieldsEdit)
      pFieldsEdit.FieldCount_2 = 2

      Dim pField As IField = New Field()
      Dim pFieldEdit As IFieldEdit = TryCast(pField, IFieldEdit)
      pFieldEdit.Name_2 = "Type"
      pFieldEdit.Type_2 = esriFieldType.esriFieldTypeString
      pFieldEdit.Length_2 = 50
      pFieldsEdit.Field_2(0) = pField

      pField = New Field()
      pFieldEdit = TryCast(pField, IFieldEdit)

      pFieldEdit.Name_2 = "Area"
      pFieldEdit.Type_2 = esriFieldType.esriFieldTypeDouble
      pFieldsEdit.Field_2(1) = pField

      prsInit.CreateTable(pFields)

      ' add all the area/type pairs
      Dim pIC As ICursor = prsInit.Insert()
      Dim pRowBuf As IRowBuffer = prsInit.CreateRowBuffer()

      Dim myEnumerator As System.Collections.IDictionaryEnumerator = dict.GetEnumerator()
      Do While myEnumerator.MoveNext()
        pRowBuf.Value(0) = myEnumerator.Key
        pRowBuf.Value(1) = myEnumerator.Value
        pIC.InsertRow(pRowBuf)
      Loop

      Return pNewRs
    End Function

    Private Function newFillS() As ISimpleFillSymbol
      Dim pSLS As ISimpleLineSymbol = New SimpleLineSymbol()
      Dim pcolor As IRgbColor = New RgbColor()
      pcolor.Red = 255
      pcolor.Green = 0
      pcolor.Blue = 0
      pSLS.Color = pcolor
      pSLS.Style = esriSimpleLineStyle.esriSLSSolid
      pSLS.Width = 2

      Dim pSFS As ISimpleFillSymbol = New SimpleFillSymbol()
      pSFS.Outline = pSLS
      pSFS.Style = esriSimpleFillStyle.esriSFSHollow

      Return pSFS
    End Function

  End Class
End Namespace