Le portail francophone de la géomatique

Public Sub Test()
'Description : Permet d'afficher l'ensemble de définition de la couche sélectionnée dans la TOC
'Date : septembre 2006

    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
    
    Dim pLayer As ILayer
    Set pLayer = pMxDoc.SelectedLayer
    
    'Vérifie que la couche sélectionné est bien de type FeatureLayer
    If TypeOf pLayer Is IFeatureLayer Then
        
        Dim pFLDEF As IFeatureLayerDefinition
        Set pFLDEF = pLayer
        
        If pFLDEF.DefinitionExpression = "" Then
            MsgBox "La couche " & pLayer.Name & " ne possède pas un ensemble de définition."
        Else
            MsgBox "La couche " & pLayer.Name & " possède un ensemble de définition :" _
                    & vbNewLine & pFLDEF.DefinitionExpression
        End If
        
    Else
        'Sinon message + sortie
        MsgBox "Veuillez sélectionner une classe d'entités.", vbInformation
        Exit Sub
    End If
    
End Sub

Public Sub Test01()
'Description : Affiche la description de la couche d'un fichier *.lyr
'              à partir d'ArcCatalog
'Date : septembre 2006
'Version : ArcView 9.0

    Dim pGxApp As IGxApplication
    Set pGxApp = Application
    
    'Récupére l'objet sélectionné
    Dim pGxSel As IGxSelection
    Set pGxSel = pGxApp.Selection
    
    Dim pGxObjet As IGxObject
    Set pGxObjet = pGxSel.FirstObject
    
    'Récupère l'emplacement du chier
    Dim pGxLayer As IGxLayer
    Set pGxLayer = New GxLayer
    
    Dim pGxFile As IGxFile
    Set pGxFile = pGxLayer
        pGxFile.Path = pGxObjet.FullName
        
   Dim pLayer As ILayer
   Set pLayer = pGxLayer.Layer
   
   'Affiche la description de la couche
   Dim pLGenPro As ILayerGeneralProperties
   Set pLGenPro = pLayer
   If Not pLGenPro.LayerDescription = "" Then
        MsgBox pLGenPro.LayerDescription
    Else
        MsgBox "Pas de description associée à " & pLayer.Name
   End If
End Sub