ArcEngine 创建要素,删除要素,生成网格,渲染图层(VB)

 Public Function CreateFeatureClass() As IFeatureClass
        Dim pWorkspaceFactory As IWorkspaceFactory = New ESRI.ArcGIS.DataSourcesGDB.AccessWorkspaceFactory
        Dim dataset As IDataset = pPointFeatureLayer.FeatureClass
        Dim featureWorkspace As IFeatureWorkspace = pWorkspaceFactory.OpenFromFile(dataset.Workspace.PathName, 0) 'dataset.Workspace.PathName="C:\\aa.mdb"
        Dim workspace As IWorkspace2 = featureWorkspace
        Dim featureClassName As String = "New"
        Dim fields As IFields = Nothing
        Dim CLSID As ESRI.ArcGIS.esriSystem.UID = Nothing
        Dim CLSEXT As ESRI.ArcGIS.esriSystem.UID = Nothing
        Dim strConfigKeyword As String = ""
        Dim featureClass As IFeatureClass
        If workspace.NameExists(esriDatasetType.esriDTFeatureClass, featureClassName) Then '如果存在删除改要素
            featureClass = featureWorkspace.OpenFeatureClass(featureClassName)
            Dim pDataset As IDataset = featureClass
            pDataset.Delete() '删除该要素
        End If
        ' 赋值类ID如果未分配
        If CLSID Is Nothing Then
            CLSID = New ESRI.ArcGIS.esriSystem.UID
            CLSID.Value = "esriGeoDatabase.Feature"
        End If
        Dim objectClassDescription As IObjectClassDescription = New FeatureClassDescription
        If fields Is Nothing Then
            ' 创建字段
            fields = objectClassDescription.RequiredFields
            Dim fieldsEdit As IFieldsEdit = CType(fields, IFieldsEdit)
            Dim field As IField = New Field
            Dim fieldEdit As IFieldEdit = CType(field, IFieldEdit) ' 显示转换
            ' 设置字段属性
            fieldEdit.Name_2 = "SampleField"
            fieldEdit.Type_2 = esriFieldType.esriFieldTypeString
            fieldEdit.IsNullable_2 = True
            fieldEdit.AliasName_2 = "Sample Field Column"
            fieldEdit.DefaultValue_2 = "test"
            fieldEdit.Editable_2 = True
            fieldEdit.Length_2 = 100
            '添加到字段集中
            fieldsEdit.AddField(field)
            fields = CType(fieldsEdit, IFields)
        End If
        Dim strShapeField As String = ""
        Dim j As Int32
        For j = 0 To fields.FieldCount
            If fields.Field(j).Type = esriFieldType.esriFieldTypeGeometry Then
                strShapeField = fields.Field(j).Name
                Exit For
            End If
        Next j
        Dim fieldChecker As IFieldChecker = New FieldChecker
        Dim enumFieldError As IEnumFieldError = Nothing
        Dim validatedFields As IFields = Nothing
        fieldChecker.ValidateWorkspace = CType(workspace, IWorkspace)
        fieldChecker.Validate(fields, enumFieldError, validatedFields)
        featureClass = featureWorkspace.CreateFeatureClass(featureClassName, validatedFields, CLSID, CLSEXT, esriFeatureType.esriFTSimple, strShapeField, strConfigKeyword)



        '添加要素,跟据其他要素的范围,生成一个边长为length的矩形网格用于渲染
        Dim length As Integer = 1000 '方块长度
        Dim pLineLayer As ILayer = pLineFeatureLayer
        Dim pEnvelope As IEnvelope = pLineLayer.AreaOfInterest
        Dim XMin As Double = pEnvelope.XMin
        Dim XMax As Double = pEnvelope.XMax

        Dim YMax As Double = pEnvelope.YMax
        Dim newXMin As Double = XMin + length

        Do While newXMin < XMax
            Dim YMin As Double = pEnvelope.YMin
            Dim newYMin As Double = YMin + length
            Do While newYMin < YMax
                AddFeature(XMin, newXMin, YMin, newYMin, featureClass.CreateFeature())
                YMin = newYMin
                newYMin = YMin + length
            Loop
            AddFeature(XMin, newXMin, YMin, newYMin, featureClass.CreateFeature())
            XMin = newXMin
            newXMin = XMin + length
        Loop
        Dim pNewFeatureLayer As IFeatureLayer = New FeatureLayer
        pNewFeatureLayer.FeatureClass = featureClass
        m_MapControl.AddLayer(pNewFeatureLayer, 3)
        m_MapControl.Refresh()
        MessageBox.Show("生成完毕")
    End Function

创建单个方格要素:

    Private Function AddFeature(ByVal XMin As Double, ByVal newXMin As Double, ByVal YMin As Double, ByVal newYMin As Double, ByVal pFeature As IFeature)
        Dim pPoint1 As IPoint = New Point()
        pPoint1.X = XMin
        pPoint1.Y = YMin
        Dim pPoint2 As IPoint = New Point()
        pPoint2.X = newXMin
        pPoint2.Y = YMin
        Dim pPoint3 As IPoint = New Point()
        pPoint3.X = newXMin
        pPoint3.Y = newYMin
        Dim pPoint4 As IPoint = New Point()
        pPoint4.X = XMin
        pPoint4.Y = newYMin
        Dim pPOlygon As IPolygon
        Dim pPointColec As IPointCollection = New Polygon
        pPointColec.AddPoint(pPoint1)
        pPointColec.AddPoint(pPoint2)
        pPointColec.AddPoint(pPoint3)
        pPointColec.AddPoint(pPoint4)
        pPOlygon = CType(pPointColec, IPolygon)
        pFeature.Shape = pPOlygon
        pFeature.Store()
    End Function

 

生成(黄色格网为生成图层)后如下图:

ArcEngine 创建要素,删除要素,生成网格,渲染图层(VB)_第1张图片

后面开始添加值和渲染图层:

通过空间查询,再生成方格(Featuer)时通过空间查询查询方格上面点的个数。

  Dim pSpatialFilter As ESRI.ArcGIS.Geodatabase.ISpatialFilter = New ESRI.ArcGIS.Geodatabase.SpatialFilter
        pSpatialFilter.Geometry = pPolygon
        pSpatialFilter.SpatialRel = esriSpatialRelEnum.esriSpatialRelIntersects '相交的状态
        Dim featureCursor As ESRI.ArcGIS.Geodatabase.IFeatureCursor = pPointFeatureLayer.FeatureClass.Search(pSpatialFilter, False)
        Dim count As Integer = 0
        Dim pTmpFeature = featureCursor.NextFeature()
        While Not IsNothing(pTmpFeature)
            count += 1
            pTmpFeature = featureCursor.NextFeature()
        End While
        Dim fieldindex As Integer = pFeature.Fields.FindField("num")
        pFeature.Value(fieldindex) = count

然后通过生成的字段进行渐变渲染

    '唯一值渲染
    Private Sub DefineUniqueValueRenderer(ByVal pGeoFeatureLayer As IGeoFeatureLayer, ByVal fieldName As String)
        '创建渐变色带
        Dim algColorRamp As IAlgorithmicColorRamp = New AlgorithmicColorRamp
        algColorRamp.FromColor = getRgbColor(245, 245, 245) '灰色
        algColorRamp.ToColor = getRgbColor(255, 0, 0)
        algColorRamp.Algorithm = esriColorRampAlgorithm.esriCIELabAlgorithm

        Dim pUniqueValueRenderer As IUniqueValueRenderer = New UniqueValueRenderer()

        Dim pSimpleFillSymbol As ISimpleFillSymbol = New SimpleFillSymbol()
        pSimpleFillSymbol.Style = esriSimpleFillStyle.esriSFSSolid
        pSimpleFillSymbol.Outline.Width = 0.4

        '这些属性之前应增加值来设置.
        pUniqueValueRenderer.FieldCount = 1
        pUniqueValueRenderer.Field(0) = fieldName
        pUniqueValueRenderer.DefaultSymbol = pSimpleFillSymbol
        pUniqueValueRenderer.UseDefaultSymbol = True

        Dim pDisplayTable As IDisplayTable = pGeoFeatureLayer
        Dim pFeatureCursor As IFeatureCursor = pDisplayTable.SearchDisplayTable(Nothing, False)

        Dim pFeature As IFeature = pFeatureCursor.NextFeature()
        Dim ValFound As Boolean
        Dim fieldIndex As Integer

        Dim pFields As IFields = pFeatureCursor.Fields
        fieldIndex = pFields.FindField(fieldName)

        While Not pFeature Is Nothing
            Dim pClassSymbol As ISimpleFillSymbol = New SimpleFillSymbol
            pClassSymbol.Style = esriSimpleFillStyle.esriSFSSolid
            pClassSymbol.Outline.Width = 0.4
            Dim classValue As String
            classValue = pFeature.Value(fieldIndex)
            '测试以查看是否该值被添加。如果没有就添加
            ValFound = False
            Dim i As Integer
            For i = 0 To pUniqueValueRenderer.ValueCount - 1 Step i + 1
                If pUniqueValueRenderer.Value(i) = classValue Then
                    ValFound = True
                    Exit For
                End If
            Next
            If ValFound = False Then
                pUniqueValueRenderer.AddValue(classValue, fieldName, pClassSymbol)
                pUniqueValueRenderer.Label(classValue) = classValue 
                pUniqueValueRenderer.Symbol(classValue) = pClassSymbol
            End If
            pFeature = pFeatureCursor.NextFeature()
        End While
        algColorRamp.Size = pUniqueValueRenderer.ValueCount
        Dim bOK As Boolean
        algColorRamp.CreateRamp(bOK)
        Dim pEnumColors As IEnumColors = algColorRamp.Colors
        pEnumColors.Reset()
        Dim j As Integer
        For j = 0 To pUniqueValueRenderer.ValueCount - 1 Step j + 1
            Dim xv As String
            xv = pUniqueValueRenderer.Value(j)
            If xv <> "" Then
                Dim pSimpleFillColor As ISimpleFillSymbol = pUniqueValueRenderer.Symbol(xv)
                pSimpleFillColor.Color = pEnumColors.Next()
                pUniqueValueRenderer.Symbol(xv) = pSimpleFillColor
            End If
        Next
        pUniqueValueRenderer.ColorScheme = "Custom"
        Dim pTable As ITable = pDisplayTable
        Dim isString As Boolean = pTable.Fields.Field(fieldIndex).Type = esriFieldType.esriFieldTypeString
        pUniqueValueRenderer.FieldType(0) = isString
        pGeoFeatureLayer.Renderer = pUniqueValueRenderer
        Dim pUID As IUID = New UID()
        pUID.Value = "{683C994E-A17B-11D1-8816-080009EC732A}"
        pGeoFeatureLayer.RendererPropertyPageClassID = pUID
    End Sub

获取Color:

 Private Function getRgbColor(ByVal r As Integer, ByVal g As Integer, ByVal b As Integer) As IColor
        Dim pRgbColr As IRgbColor = New RgbColor
        pRgbColr.Red = r
        pRgbColr.Green = g
        pRgbColr.Blue = b
        Dim pColor As IColor = CType(pRgbColr, IColor)
        Return pColor
    End Function

生成后的效果如下图:

ArcEngine 创建要素,删除要素,生成网格,渲染图层(VB)_第2张图片

 

你可能感兴趣的:(ArcEngine 创建要素,删除要素,生成网格,渲染图层(VB))