Le portail francophone de la géomatique

Public Function DeleteEmptyShapeFeature(ByVal pFeatCls As esriGeoDatabase.IFeatureClass) As Boolean
'=====================================================================================================
'| Projet : Project
'| Module : mdlArcGIS, Module
'| Nom : DeleteEmptyShapeFeature Function, Boolean
'| Paramètres :
'|      > ByVal pFeatCls As esriGeoDatabase.IFeatureClass:
'|          - Classe d'entitées à vérifier
'|----------------------------------------------------------------------------------------------------
'| Auteur : GGlaFouine
'| Date de création : 2009-06-05
'|----------------------------------------------------------------------------------------------------
'| But : Supprimer les enregistrements n'ayant pas de géométrie
'|----------------------------------------------------------------------------------------------------
'| Procédures Appelées :
'| Modifications :
'=====================================================================================================

    Dim pFeatCursor As esriGeoDatabase.IFeatureCursor
    Set pFeatCursor = pFeatCls.Search(Nothing, False)
   
    Dim pFeat As esriGeoDatabase.IFeature
    Set pFeat = pFeatCursor.NextFeature

    'Vérifier l'existance de géométrie inexistante dans les enregistrements
    Do While (Not pFeat Is Nothing)
        If Not pFeat.Shape Is Nothing Then
            If pFeat.Shape.IsEmpty Then
                'action à réaliser si la géométrie du champs est vide
                pFeat.Delete 'supression
            End If
        End If
        Set pFeat = pFeatCursor.NextFeature
    Loop
    DeleteEmptyShapeFeature = True
End Function

Public Function AddSpatialIndex(ByVal WorkspacePath As String, ByVal strFileName As String) As Boolean
'=====================================================================================================
'| Projet : Project
'| Module : mdlArcGIS, Module
'| Nom : AddSpatialIndex Function, Boolean
'| Paramètres :
'|      > ByVal WorkspacePath As String:
'|          - Localisation du jeu de données (espace de travail)
'|      > ByVal strFileName As String:
'|          - Nom du shapefile (ou de la table de géodatabase)
'|----------------------------------------------------------------------------------------------------
'| Auteur : GGlaFouine
'| Date de création : 2009-07-24
'|----------------------------------------------------------------------------------------------------
'| But : Ajout d'un index spatiale
'|----------------------------------------------------------------------------------------------------
'| Procédures Appelées :
'| Modifications :
'=====================================================================================================
  AddSpatialIndex = False
  On Error GoTo CheckError
  Dim GP As Object
  Set GP = CreateObject("esriGeoprocessing.GpDispatch.1")

    'attribuer l'espace de travail
     GP.Workspace = WorkspacePath

    'définir la toolbox à prendre en compte
     GP.Toolbox = "management"
  
    'ajouter l'index spatial au jeux de données
    GP.AddSpatialIndex WorkspacePath & "\" & strFileName
    
    AddSpatialIndex = True
Fin:
Exit Function
CheckError:
GoTo Fin
End Function

Public Sub RemoveLayerInActiveView()
'=====================================================================================================
'| Projet : Project
'| Module : mdlArcGIS, Module
'| Nom : RemoveLayerInActiveView Sub
'| Paramètres :
'|----------------------------------------------------------------------------------------------------
'| Auteur : GGlaFouine
'| Date de création : 2009-07-24
'|----------------------------------------------------------------------------------------------------
'| But : supprimer tous les couches de la vue active
'|----------------------------------------------------------------------------------------------------
'| Procédures Appelées :
'| Modifications :
'=====================================================================================================

    Dim pMap As IMap
    Dim pActiveView As IActiveView
    Dim pEnumLayer As IEnumLayer
    Dim pLayer As ILayer
  
    Set pMap = g_MxDoc.FocusMap
    Set pActiveView = pMap
    
    ' si aucune couche n'est chargée
    If pMap.LayerCount = 0 Then
        GoTo Fin:
    Else
        Set pEnumLayer = pMap.Layers(Nothing, True)
        Set pLayer = pEnumLayer.Next
        Do Until pLayer Is Nothing
            pMap.DeleteLayer pLayer
            Set pLayer = pEnumLayer.Next
        Loop
    pActiveView.Refresh
    End If
Fin:
End Sub