Le portail francophone de la géomatique

Tient c'est marrant, je fait ça aujourd'hui aussi. Faut passer par du VBA pour cela. Je suis au stade "supérieur". j'ai récupérer un bout de code mais ça marche presque pas bien du tout. Faut dire que VBA = chinois pour moi :-)

J'ai récupérer le code sur le forum SIG. Dites les modos, je peux le coller par ici pour voir si quelqu'un peut le customiser ou expliquer rapidement comment l'utiliser ???

EDIT : J'ai une grille correspondant à l'emprise de mes rasters (fait avec l'outil d'esri proposer par Kevin Jousseaum) avec un champ contenant le nom de l'image (image.ecw ou tif) et un champ avec le chemin complet de l'image.

Voici le code que j'essaye d'utiliser.

Option Explicit
Const NOM_CHAMP = "NOM_IMAGE"
Const CHEMIN_DOSSIER = "C:\lablatte\carto\BDortho_44\"


Public Sub test()
'---------------------------------------------------------------------------------------
' Module    : ThisDocument
' DateTime  : 02/10/2007
' Purpose   : Permet d'ajouter les rasters correspondants aux emprises sélectionnées
'---------------------------------------------------------------------------------------
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
    
    Dim pMap As IMap
    Set pMap = pMxDoc.FocusMap
    
    'Recherche la sélection de la grille
    Dim pFLayer As IFeatureLayer
    Set pFLayer = pMap.Layer(0)

    Dim pFSelection As IFeatureSelection
    Set pFSelection = pFLayer
    
    If pFSelection.SelectionSet.Count = 0 Then
        MsgBox "Veuillez sélectionner les entités."
        Exit Sub
    Else
        Dim pFCursor As IFeatureCursor
        Dim pSelectSet As ISelectionSet
        Set pSelectSet = pFSelection.SelectionSet
            pSelectSet.Search Nothing, False, pFCursor
        Dim pFeature As IFeature
        Set pFeature = pFCursor.NextFeature
        
        Do Until pFeature Is Nothing
            'Récupère l'index du champ
            Dim pindexField As Long
                pindexField = pFLayer.FeatureClass.FindField(NOM_CHAMP)
            'Récupère le nom du raster
            Dim sNomRaster As String
                sNomRaster = pFeature.Value(pindexField)
            'Ajout l'image
            Call AjouterRaster(pMap, CHEMIN_DOSSIER, sNomRaster)
        Set pFeature = pFCursor.NextFeature
        Loop
    End If

    pMxDoc.ActiveView.Refresh
    pMxDoc.UpdateContents
    MsgBox pSelectSet.Count & " rasters ajoutés."
End Sub
Public Sub AjouterRaster(pMap As IMap, sCheminRaster As String, sNomRaster As String)
    Dim pWSF As IWorkspaceFactory
    Set pWSF = New RasterWorkspaceFactory
    
    Dim pWS As IRasterWorkspace
    Set pWS = pWSF.OpenFromFile(sCheminRaster, 0)
    
    Dim pRasterDataset As IRasterDataset
    Set pRasterDataset = pWS.OpenRasterDataset(sNomRaster & ".tif")
    
    Dim pRasterLayer As IRasterLayer
    Set pRasterLayer = New RasterLayer
    pRasterLayer.CreateFromDataset pRasterDataset
    
    pMap.AddLayer pRasterLayer
    
    pMap.MoveLayer pRasterLayer, pMap.LayerCount
        
End Sub

Ca marche presque puisque quand je n'ai aucun polygone de selectionner et que j'execute le code il me dit de selectionner un entité. Mais quand je selectionne une ou plusieurs entité il me dit ça  (voir pj)

Dernière modification par lablatte (Fri 29 February 2008 09:34)

J'ai trouvé le problème
C'était cette ligne là

 Set pRasterDataset = pWS.OpenRasterDataset(sNomRaster & ".tif")

Comme dans le champ qui contient le nom de l'image j'avais déja l'extension .tif (nomimage.tif et non pas nomimage), ce n'était pas la peine de le remettre dans le code.
Donc voici la bonne formule

 Set pRasterDataset = pWS.OpenRasterDataset(sNomRaster)

Il suffisait de virer le & ".tif"

Si j'arrive a en faire un bouton cliquable, je mettrais le code ici pour les buses en programmation comme moi.

Merci a FredXIII du Forum SIG pour son aide.

Dernière modification par lablatte (Mon 03 March 2008 14:56)

Ha oui d'accord, mais moi je veux (comme Anne, qui d'ailleurs a déserté :-)) que l'image s'ajoute a ma carte courante dans arcview, pas qu'elle s'ouvre avec un logiciel de photo, d'image ou le visionneur d'image de windows.

J'ai réussi a en faire un bouton dans la barre d'outils ce qui est très pratique. De plus pour créer mes polygone d'emprise j'utilise l'outil du site esri (voir lien sur le post de Kevin J.) qui te crée une table contenant le nom de l'image et le chemin. Bref tout ça vas très vite une fois le code en place.
IL faut quand même que j'améliore tout ça pour qu'il aillle chercher le chemin du répertoire des images dans le champ "répretoire", car dans le bout de code que je donne (enfin que j'ai pompé ailleur pour être précis) le repertoire est figé au départ. Et comme tout mes rasters ne sont pas au même endroit...
D'ailleur si un super programmeur VB passe par là ^^. Il fera en 5min ce que vais mettre un mois a faire.

Merci du tuyau, ça peut servir quand même.

Matt

Youhou !!!
Merci, j'avais bien tenté de faire quelque chose du style mais comme c'est un peu de l'hebreu pour moi, j'ai eu quelques difficultés. Et comme à une virgule près ça ne marche pas...Mon autoformation en VB est quelque peu limitée ^^
Je vais essayer ça quand j'aurais 5 min.

Merci Monsieur Kévin J.

EDIT : Utiliser arcview sans VB c'est un peu comme pilloter une F1 en centre ville.

Dernière modification par lablatte (Tue 11 March 2008 16:03)

Bonjour,

Rendons à lablatte ce qui est à lablatte : je ne suis pas à l'origine du code ci-dessous, je n'ai fait qu'apporter de petites modifications à ce que lablatte avait écrit .
De fait, dans la partie du code que j'ai repris, la fonction AjouterRaster() n'est pas implémentée. Cette fonction se trouve cependant dans le message de lablatte datant du jeudi 28 février 2008 à 16:24.

Pour rappel, le code utilisé s'appuie sur une grille générée par un outil développée par Esri. Ainsi, lablatte a écrit le jeudi 28 février 2008 16:24 :

En vous souhaitant bon courage,
Kevin.

Bonjour,

J'ai un nouveau souci lorsque je lance le code que vous avez mis à notre disposition.

Dans un premier temps, j'ai le message "veuillez sélectionner les entités" qui s'affiche, comme ce qu'avait indiqué Lablatte le jeudi 28 Fevrier.

J'ai donc supprimé    & ".tif"      de la partie    Set pRasterDataset = pWS.OpenRasterDataset(sNomRaster & ".tif")
comme l'avait indiqué Lablatte.

Mais lorsque je fais à nouveau tourner le code, le même message (veuillez sélectionner les entités) apparaît.

Lorsque je sélectionne l'une des cellules de ma grille, générée avec l'outil d'esri "Créer un catalogue d'images et les polygones d'emprise", et que je relance le code, j'ai une erreur qui apparaît sur "sNomRaster = pFeature.Value(pindexFieldNomImage)". J'ai mis le message d'erreur qui s'affiche en pièce jointe.

Pouvez-vous m'aider ?

En vous remerciant...

Gaëlle



Voici l'intégralité du code que j'ai utilisé :

Option Explicit
Const IMAGENAME = "NOM DE L'IMAGE"
Const FULLPATH = "REPERTOIRE"
'Const FULLPATH = "X:\BD_ORTHO\26\"

Public Sub test()
'---------------------------------------------------------------------------------------
' Module    : ThisDocument
' DateTime  : 02/10/2007
' Purpose   : Permet d'ajouter les rasters correspondants aux emprises sélectionnées
'---------------------------------------------------------------------------------------
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
    
    Dim pMap As IMap
    Set pMap = pMxDoc.FocusMap
    
    'Recherche la sélection de la grille
    Dim pFLayer As IFeatureLayer
    Set pFLayer = pMap.Layer(0)

    Dim pFSelection As IFeatureSelection
    Set pFSelection = pFLayer
    
    If pFSelection.SelectionSet.Count = 0 Then
        MsgBox "Veuillez sélectionner les entités."
        Exit Sub
    Else
        Dim pFCursor As IFeatureCursor
        Dim pSelectSet As ISelectionSet

        Set pSelectSet = pFSelection.SelectionSet
        pSelectSet.Search Nothing, False, pFCursor

        Dim pFeature As IFeature
        Set pFeature = pFCursor.NextFeature
        
        'Récupère l'index du champ contenant le nom de l'image
        Dim pindexFieldNomImage As Long
        pindexFieldNomImage = pFLayer.FeatureClass.FindField(IMAGENAME)
        
        'Récupère l'index du champ contenant le nom du répertoire contenant l'image
        Dim pindexFieldNomRep As Long
        pindexFieldNomRep = pFLayer.FeatureClass.FindField(FULLPATH)
  
        Dim sNomRaster As String
        Dim sNomRepertoire As String

        Do Until pFeature Is Nothing
            'Récupère le nom du raster
            sNomRaster = pFeature.Value(pindexFieldNomImage)

            'Récupère le nom du répertoire contenant le raster
            sNomRepertoire = pFeature.Value(pindexFieldNomRep)

            'Ajout l'image
            'Call AjouterRaster(pMap, CHEMIN_DOSSIER, sNomRaster)
        Call AjouterRaster(pMap, sNomRepertoire, sNomRaster)

            Set pFeature = pFCursor.NextFeature
        Loop
    End If

    pMxDoc.ActiveView.Refresh
    pMxDoc.UpdateContents
    MsgBox pSelectSet.Count & " rasters ajoutés."
End Sub
Public Sub AjouterRaster(pMap As IMap, sCheminRaster As String, sNomRaster As String)
    Dim pWSF As IWorkspaceFactory
    Set pWSF = New RasterWorkspaceFactory
    
    Dim pWS As IRasterWorkspace
    Set pWS = pWSF.OpenFromFile(sCheminRaster, 0)
    
    Dim pRasterDataset As IRasterDataset
    Set pRasterDataset = pWS.OpenRasterDataset(sNomRaster)
    
    Dim pRasterLayer As IRasterLayer
    Set pRasterLayer = New RasterLayer
    pRasterLayer.CreateFromDataset pRasterDataset
    
    pMap.AddLayer pRasterLayer
    
    pMap.MoveLayer pRasterLayer, pMap.LayerCount
        
End Sub

Je ne comprends pas très bien...

J'ai mis en pièce jointe la structure de ma grille "cliquable". Peut-être pourrez-vous m'indiquer ce que je dois écrire dans le code ?

j'ai déjà essayé en remplaçant la partie de code de cette façon :

Option Explicit
Const IMAGENAME = "IMAGENAME"
Const FULLPATH = "FULLPATH"

ce qui ne change rien à mon problème...

Je suis surpris que cela ne change rien à votre problème. Pourriez-vous regarder la valeur de votre variable pindexFieldNomImage ? Si elle vaut un nombre inférieur à 0, c'est que votre couche de données ne contient pas le champ recherché.

Je pense également que le problème vient du fait que vos données ne soient pas structurées de la même manière que celles de lablatte (tout du moins dans leur version finale...). Dans votre cas, vos données possèdent 1 champ "FULLPATH" qui contient le chemin complet de chaque image. Or la fonction AjouterRaster attend en paramètres le nom de l'image et l'emplacement du dossier contenant l'image, or si vous lui indiquez bien le nom de l'image, vous lui indiquez ensuite le chemin complet de votre image et non le chemin du dossier la contenant.

Pourriez-vous essayer de remplacer

Par

Et si cela ne marche toujours pas, cela peut aussi venir de la présence de l'extension ".ecw" qui est présente dans la valeur du nom de l'image. Je pense qu'il vous faut l'enlever, par exemple en supprimant les 4 derniers caractères de la variable sNomRaster au sein de la boucle en question.

Bon courage,
Kevin.

PS: pour la tautologie, n'y prenez pas garde, c'était plus une plaisanterie qu'autre chose .

Dernière modification par Kevin Jousseaume (Mon 21 April 2008 13:37)

Ca y est. J'ai supprimé les extensions .ecw contenues dans le champ "IMAGENAME".
Ne faut-il pas supprimer également ces extensions dans "FULLPATH" ?