Le portail francophone de la géomatique

 Public Shared Sub CreateFishnet(ByVal pMap As IMap, ByVal strLayerNameVector As String, ByVal IntCellSize As Integer)
        Try
            '1- Récupération de la couche vecteur
            If pMap Is Nothing Then
                MessageBox.Show("Fonction CreateFishnet : IMap n'est pas récupéré.")
                Exit Sub
            End If

            Dim lngIdLayer As Long = 0
            lngIdLayer = FindIdLayerByName(strLayerNameVector, pMap)

            Dim player As ILayer2
            player = pMap.Layer(lngIdLayer)

            If player Is Nothing Then
                MessageBox.Show("Fonction CreateFishnet : ILayer n'est pas récupéré.")
                Exit Sub
            End If

            Dim pflayer As IFeatureLayer
            pflayer = CType(player, IFeatureLayer)

            Dim pFclass As IFeatureClass
            pFclass = pflayer.FeatureClass

            Dim pDataset As IDataset = CType(pFclass, IDataset)

            Dim pGeoDS As IGeoDataset
            pGeoDS = CType(player, IGeoDataset)

            Dim pSpatialReference As ISpatialReference
            pSpatialReference = pGeoDS.SpatialReference

            Dim strSpatialReference As String = pSpatialReference.Name

            Dim pEnvelope As IEnvelope = pGeoDS.Extent

            '2- dimensionnement de l'enveloppe pour le fishnet
            Dim dbl_Right As Double = pEnvelope.XMax
            Dim dbl_Left As Double = pEnvelope.XMin
            Dim dbl_Top As Double = pEnvelope.YMax
            Dim dbl_Bottom As Double = pEnvelope.YMin

            'attribution des paramètres coordonnées
            Dim dbl_coordX As Double = dbl_Left
            Dim dbl_coordY As Double = dbl_Bottom
            Dim dbl_OppositeCornerX As Double = dbl_Right
            Dim dbl_OppositeCornerY As Double = dbl_Top

            'détermination du nb de lignes et de colonnes
            Dim dbl_Longueur As Double = 0.0
            Dim dbl_largeur As Double = 0.0

            If dbl_Left < dbl_Right Then
                dbl_Longueur = dbl_Right - dbl_Left
            ElseIf dbl_Left > dbl_Right Then
                dbl_Longueur = dbl_Left - dbl_Right
            End If
            dbl_largeur = dbl_Top - dbl_Bottom

            Dim dbl_nbLignes As Double = 0.0
            Dim dbl_nbColonnes As Double = 0.0
            dbl_nbLignes = dbl_largeur / IntCellSize
            dbl_nbColonnes = dbl_Longueur / IntCellSize
            Dim int_nbLignes As Integer = CInt(dbl_nbLignes)
            Dim int_nbColonnes As Integer = CInt(dbl_nbColonnes)

            '3- définition des points nécessaires à la création du fishnet (maillage)
            Dim pPointOriginCoord As IPoint = New Point
            pPointOriginCoord.X = dbl_Left
            pPointOriginCoord.Y = dbl_Bottom
            Dim pPointYaxisCoord As IPoint = New Point
            pPointYaxisCoord.X = dbl_Left
            pPointYaxisCoord.Y = dbl_Bottom
            Dim pPointCornerCoord As IPoint = New Point
            pPointCornerCoord.X = dbl_Right
            pPointCornerCoord.Y = dbl_Top

            '4- Create a feature class
            Dim FeatureClassName As String = "test_code.shp"
            Dim pWorkspace As IWorkspace = pDataset.Workspace
            Dim featureWorkspace As IFeatureWorkspace = CType(pWorkspace, IFeatureWorkspace)
            ' Instantiate a feature class description to get the required fields.
            Dim fcDescription As IFeatureClassDescription = New FeatureClassDescriptionClass()
            Dim ocDescription As IObjectClassDescription = CType(fcDescription, IObjectClassDescription)
            Dim fields As IFields = ocDescription.RequiredFields
            Dim fieldsEdit As IFieldsEdit = CType(fields, IFieldsEdit)

            ' Add a Name text field to the required fields.
            Dim field As IField = New FieldClass()
            Dim fieldEdit As IFieldEdit = CType(field, IFieldEdit)
            fieldEdit.Name_2 = "Name"
            fieldEdit.Type_2 = esriFieldType.esriFieldTypeString
            fieldsEdit.AddField(field)

            ' Use IFieldChecker to create a validated fields collection.
            Dim fieldChecker As IFieldChecker = New FieldCheckerClass()
            Dim enumFieldError As IEnumFieldError = Nothing
            Dim validatedFields As IFields = Nothing
            fieldChecker.ValidateWorkspace = CType(featureWorkspace, IWorkspace)
            fieldChecker.Validate(fields, enumFieldError, validatedFields)

            ' The enumFieldError enumerator can be inspected at this point to determine
            ' which fields were modified during validation.
            ' Create the feature class.
            Dim featureClass As IFeatureClass = featureWorkspace.CreateFeatureClass(FeatureClassName, validatedFields, _
                                                ocDescription.InstanceCLSID, ocDescription.ClassExtensionCLSID, esriFeatureType.esriFTSimple, _
                                                fcDescription.ShapeFieldName, "")

            '5- Create Fishnet
            Dim pCreatefishnet As ESRI.ArcGIS.DataManagementTools.CreateFishnet = New CreateFishnet()
            pCreatefishnet.out_feature_class = featureClass
            'pCreatefishnet.template = pGeoDS.Extent
            'pCreatefishnet.corner_coord = pPointCornerCoord
            pCreatefishnet.origin_coord = pPointOriginCoord
            pCreatefishnet.y_axis_coord = pPointYaxisCoord
            pCreatefishnet.cell_height = CDbl(IntCellSize)
            pCreatefishnet.cell_width = CDbl(IntCellSize)
            pCreatefishnet.number_rows = int_nbLignes
            pCreatefishnet.number_columns = int_nbColonnes
            pCreatefishnet.labels = True
            pCreatefishnet.geometry_type = esriGeometryType.esriGeometryPolygon

            Dim pGpProcess As ESRI.ArcGIS.Geoprocessor.IGPProcess
            pGpProcess = CType(pCreatefishnet, ESRI.ArcGIS.Geoprocessor.IGPProcess)

            Dim pExecGeoprocess As New ESRI.ArcGIS.Geoprocessor.Geoprocessor
            pExecGeoprocess.Validate(pCreatefishnet, True)
            RunToolBoxGeoprocess(pExecGeoprocess, pGpProcess, Nothing)

        Catch ex As Exception
            MessageBox.Show("Fonction CreateFishnet : " & ex.Message)
        End Try
    End Sub

    Public Shared Sub RunToolBoxGeoprocess(ByVal geoprocessor As ESRI.ArcGIS.Geoprocessor.Geoprocessor, ByVal process As ESRI.ArcGIS.Geoprocessor.IGPProcess, ByVal TC As ITrackCancel)
        geoprocessor.OverwriteOutput = True
        geoprocessor.AddOutputsToMap = True
        Try
            geoprocessor.Execute(process, Nothing)
        Catch ex As Exception
            MessageBox.Show("Fonction RunToolBoxGeoprocess : " & ex.Message)
        End Try
    End Sub