banniere

Le portail francophone de la géomatique


Toujours pas inscrit ? Mot de passe oublié ?
Nom d'utilisateur    Mot de passe              Toujours pas inscrit ?   Mot de passe oublié ?

#1 Fri 22 August 2008 11:43

Fabien.Krzewinski
Participant occasionnel
Date d'inscription: 19 Aug 2008
Messages: 18

[Vba] Récupérer l'extent

Bonjour,

Après de longue recherches (forum, IMap,ILayer,etc..), je ne vois pas comment récupérer l'extent en vba...

Si quelqu'un pouvait m'aider, je lui en serai très reconnaissant smile .

D'avance, merci !

Fabien

Hors ligne

 

#2 Fri 22 August 2008 12:16

Tnarbiv
Participant assidu
Lieu: Véretz
Date d'inscription: 5 Sep 2005
Messages: 392

Re: [Vba] Récupérer l'extent

tu veux récupérer l'extent de quoi ???

voici un exemple pour récupérer l'extent de chaque entité d'une couche.

Code:

Sub test()
Dim pmxdoc As IMxDocument
Set pmxdoc = ThisDocument
Dim pmap As IMap
Set pmap = pmxdoc.FocusMap
Dim player As ILayer
Set player = pmap.Layer(0)
If TypeOf player Is IFeatureLayer Then
    Dim pfl As IFeatureLayer
    Set pfl = player
    Dim pfc As IFeatureClass
    Set pfc = pfl.FeatureClass
    Dim pfcursor As IFeatureCursor
    Set pfcursor = pfc.Search(Nothing, True)
    Dim pfeature As IFeature
    Set pfeature = pfcursor.NextFeature
    Do Until pfeature Is Nothing
        Debug.Print pfeature.Extent.XMin
        Debug.Print pfeature.Extent.XMax
        Debug.Print pfeature.Extent.YMin
        Debug.Print pfeature.Extent.YMax
    Loop
    
End If

End Sub

Ayez le réflexe "Développement Durable": N'imprimez ce message que si nécessaire.

Hors ligne

 

#3 Fri 22 August 2008 13:56

Fabien.Krzewinski
Participant occasionnel
Date d'inscription: 19 Aug 2008
Messages: 18

Re: [Vba] Récupérer l'extent

Je voulais récupérer l'extent d'une couche.

Je te remercie de ton aide.

Fabien.

Hors ligne

 

#4 Fri 22 August 2008 14:12

Tnarbiv
Participant assidu
Lieu: Véretz
Date d'inscription: 5 Sep 2005
Messages: 392

Re: [Vba] Récupérer l'extent

voici comment obtenir l'extent d'une couche

Code:

Sub test()
Dim pmxdoc As IMxDocument
Set pmxdoc = ThisDocument
Dim pmap As IMap
Set pmap = pmxdoc.FocusMap
Dim player As ILayer
Set player = pmap.Layer(0)
Dim penv As IEnvelope
Set penv = player.AreaOfInterest
Debug.Print penv.XMin
Debug.Print penv.XMax
Debug.Print penv.YMin
Debug.Print penv.YMax
End Sub

Ayez le réflexe "Développement Durable": N'imprimez ce message que si nécessaire.

Hors ligne

 

Pied de page des forums

Powered by FluxBB