La France rasterisée mais la France vectorisée ! [Résolu]

[philben]

bonjour,

je cherche une vectorisation de la France pour pouvoir afficher au choix selon des requetes :
- ses contours
- ses régions
- ses départements

Y'a bien la table TDepartement de Arkham46 dans son excellente gestion des images (http://arkham46.developpez.com/) mais on ne peut afficher que les départements et je cherche une plus grande précision.

cordialement,

Philippe

[philben]

j'ai trouvé une solution intéressante que je suis en train de tester :

1° récupérer un fichier kml ou kmz qui comporte les limites des départements, altitudes, les communes, etc... (le plus souvent libres de droits)

2° l'importer dans access (structure xml des kml, kmz = .zip)

3° soit à la volée soit a priori, traduire les coordonnées géographiques (latitudes et longitudes - wgs84) en une projection de votre choix (Mercator, miller,...) dans un espace définie pour affichage ou enregistrement dans une table.

4° grande précision garantie !

Philippe

[vodiem]

vraiment génial,
je savais que google, michelin, mappy fournissaient api et tout le tralala... mais je pensais que cela se limitait à la géolocalisation.

c'est vraiment géant!

[Philippe JOCHMANS]

Salut philben

Tout cela est très intéressant.

Cela te serait-il possible de détailler un peu plus étape par étape comment tu procèdes, car cela pourrait être très utile pour d'autre membres.

Soit une très bonne contribution ou le mieux un petit article sur le sujet, ce qui serait préférable.
Pour l'article va voir le lien dans ma signature.

Starec

[vodiem]

salut Starec,
toujours aussi matinal

tu disais "une très bonne contribution"? avec philben j'appel ca un pléonasme.
"un petit article sur le sujet", moi je dis même un grand. remarque qu'avec philben vaut mieux peut être demander petit si on veut un grand vu qu'il ne fait pas les choses à moitié.

on va lui laisser le temps de tester, parcequ'il y a de la lecture d'après ce que j'ai vu. mais en soit cela ne devra pas être très compliqué c'est de l'xml avec une liste de coordonnées.

coté précision, le fichier que j'ai chargé ben je trouve pas tant que ca, le contour des cotes c'est pas au pixel près, mais bon on va dire que c'est pas si mauvais que cela et en tout cas c'est de loin ce qu'il y a de plus précis parmi ce que j'ai vu.

[philben]

re bonjour,

voici un échantillon des tracés obtenus, avec un Me.width = 1 dans Report. Délai d'affichage de l'état : 3 à 5 secondes

La France en projection Miller


Détail de la bretagne


La terre en projection Miller


La terre en projection orthographique (face cachée en ligne grisée)


Pour Vodiem :
La précision est suffisante pour mon usage, tu devrai essayer d'interfacer Virtual Earth dans Access, c'est pas mal...

Pour Starec :
J'ai pas bien le temps pour plus d'info, mais franchement c'est tout simple, les formules des projections sont sur wikipedia, l'import xml passe par la référence <Microsoft.XMLDOM>, l'affichage se fait avec la fonction Line.

cordialement,

Philippe

[philben]

re,

pour valider la projection de Miller, j'ai mis un fond de carte utilisant cette projection et j'ai tracé en rouge par dessus. Ca semble bien correspondre (image dans le domaine public)



Bon, j'arrête là sinon je vais me faire houspiller...

Philippe

[Domi2]

Bonsoir,

Je n'envisage pas d'application nécessitant ce genre de choses...

Ceci dit :

mais franchement c'est tout simple

... j'ai des doutes...

Pour ce qui est du résultat...



Domi2

[vodiem]

salut à tous,

philben, j'ai pris le temps ce wk de regarder cela de plus près.
j'arrive bien à afficher la carte de france mais j'ai un petit soucis pour la projection de miller.
j'utilise la formule ci
seulement la tangente renvoie des valeurs négatives qui bien entendu provoque une erreur dans le logarithme pour certaine valeur.
en passant outre j'ai des étirements exésifs sur la carte de france, alors que la prévisualisation sans la projection ne pose pas de pb (seulement un tassement vertical).

pourrais tu me dire quelle formule utilises tu?
merci.

[vodiem]

ok, la formule n'est pas en cause, kml utilise le degré et non le radian.
ca marche impec.

[philben]

Salut Vodiem

Voici mon brut de fonderie :

1) J'ai récupéré le contour des états ici
2) Création d'une table (tmppays) avec 2 colonnes :
- Nom (type texte)
- Contours (type mémo)
3) import du fichier doc.kml seulement le nom du pays et les coordonnées (Lat/Long) des points du contour en sachant que la troisième coordonnées est supprimée à l'import (0 pour chaque point, altitude?). Utilise la réf xmldom.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
 
   Dim lCountPays As Long
   Dim sFile As String, sChem As String, sLonLat As String
   Dim oXmldoc As Object
   Dim oFolder As Object, oPays As Object, oPolygon As Object, oLR As Object
   Dim oDb As DAO.Database
   Dim oRs As DAO.Recordset
   On Error GoTo errtag
   Set oDb = CurrentDb
   'reset la table
   oDb.Execute "delete from tmppays", dbFailOnError
   Set oRs = oDb.OpenRecordset("tmppays", dbOpenTable)
   Set oXmldoc = CreateObject("Microsoft.XMLDOM")
   sFile = CurrentProject.Path & "\" & "doc.kml"
   oXmldoc.Async = False
   oXmldoc.Load (sFile)
   For Each oFolder In oXmldoc.selectNodes("kml/Document/Folder")
      For Each oPays In oFolder.selectNodes("Placemark")
         lCountPays = lCountPays + 1
         If oPays.selectNodes("MultiGeometry").length > 0 Then
            sChem = "MultiGeometry/Polygon"
         Else
            sChem = "Polygon"
         End If
         For Each oPolygon In oPays.selectNodes(sChem)
            For Each oLR In oPolygon.selectNodes("outerBoundaryIs/LinearRing")
               oRs.AddNew
               oRs!nom = oPays.selectSingleNode("name").Text
               'Efface les données inutiles
               sLonLat = Replace(oLR.selectSingleNode("coordinates").Text, ",0 ", ",")
               'supprime le dernier <,0>
               oRs!contours = Left$(sLonLat, Len(sLonLat) - 2)
               oRs.Update
            Next oLR
         Next oPolygon
         If lCountPays Mod 10 = 0 Then
Debug.Print lCountPays
            DoEvents
         End If
      Next oPays
   Next oFolder
fin:
   Set oXmldoc = Nothing
   Set oRs = Nothing
   Set oDb = Nothing
Debug.Print lCountPays
   MsgBox "fin"
   Exit Sub
errtag:
Debug.Print Err, Err.Description
   Resume fin

On récupère ainsi + de 100 000 points en degrés décimaux.

4) Affichage dans un rapport de la projection de miller sur le fond de carte calé en 0,0 dans la section détail.
Je suis parti du code de Maitre Starec (merci au passage pour tes tutos IHM qui rendent Access plus attrayant encore ) :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
 
 
#Const ccCALCRANGES = False
Private Type tXY
   dx As Double
   dy As Double
End Type
Private gdPI As Double
Private Sub Report_Page()
   Dim oDb As DAO.Database
   Dim oRs As DAO.Recordset
   Dim asPoints() As String
   Dim i As Long, lColor As Long, lEtendue As Long
   Dim dZoomX As Double, dZoomY As Double, dRapportXSurY As Double
   Dim dPi As Double, dDecalageX As Double, dDecalageY As Double
   Dim dMinX As Double, dMaxX As Double, dMinY As Double
   Dim tPoint1 As tXY, tPoint2 As tXY
   'Calcul de PI
   gdPI = 4 * Atn(1)
   'Ouverture de la table
   Set oDb = CurrentDb
   Set oRs = oDb.OpenRecordset("tmppays", dbOpenTable)
   '1ère boucle pour déterminer les valeurs extrèmes de la projection
#If ccCALCRANGES Then
   dMinX = 2 ^ 30
   dMinY = 2 ^ 30
   While Not oRs.EOF
      asPoints = Split(oRs!contours, ",")
      For i = 0 To UBound(asPoints()) - 1 Step 2
         tPoint1 = GetXYFromProjMiller(Val(asPoints(i)), Val(asPoints(i + 1)))
         If tPoint1.dx < dMinX Then dMinX = tPoint1.dx
         If tPoint1.dx > dMaxX Then dMaxX = tPoint1.dx
         If tPoint1.dy < dMinY Then dMinY = tPoint1.dy
      Next i
      oRs.MoveNext
   Wend
Debug.Print "dMinX:" & dMinX, "dMaxX:" & dMaxX, "dMinY:" & dMinY
#Else
   dMinX = -3.1415958493831
   dMaxX = 3.14159265358979
   dMinY = -1.98474497464755
#End If
   'Paramètres du dessin
   Me.DrawWidth = 1
   lColor = vbRed
   'Paramètres de centrage sur l'image
   dRapportXSurY = 1
   dZoomX = Me.ImageMiller.ImageWidth / (dMaxX - dMinX)
   dDecalageX = -(dMinX * dZoomX) + 10
   dZoomY = dZoomX * dRapportXSurY
   dDecalageY = -(dMinY * dZoomY) + 255
   'Dessine le contour des pays selon la projection de Miller
   oRs.MoveFirst
   While Not oRs.EOF
      asPoints = Split(oRs!contours, ",")
      For i = 0 To UBound(asPoints()) - 3 Step 2
         tPoint1 = GetXYFromProjMiller(Val(asPoints(i)), Val(asPoints(i + 1)))
         tPoint2 = GetXYFromProjMiller(Val(asPoints(i + 2)), Val(asPoints(i + 3)))
         Me.Line ((dZoomX * tPoint1.dx) + dDecalageX, _
                  (dZoomY * tPoint1.dy) + dDecalageY)- _
                  ((dZoomX * tPoint2.dx) + dDecalageX, _
                   (dZoomY * tPoint2.dy) + dDecalageY), lColor
      Next i
      oRs.MoveNext
   Wend
   Set oRs = Nothing
   Set oDb = Nothing
End Sub
 
Private Function GetXYFromProjMiller(ByVal dLon As Double, ByVal dLat As Double) As tXY
   GetXYFromProjMiller.dx = dLon * gdPI / 180
   GetXYFromProjMiller.dy = -1.25 * Log(Tan(gdPI * (0.25 + dLat / 450)))
End Function

Pour la France, ca se complique un peu. En effet il faut connaitre le type de projection utilisée pour pouvoir caler les départements puis déterminer les paramètres du positionnement...
Par exemple, en utilisant le fond de carte FranceR1 sur le site IGN, j'ai réussi a peu près à me caler dessus en utilisant une projection orthographique avec :
- une longitude de référence à 2,3
- une latitude de réf. à 48
et en jouant sur la valeur du zoom et des décalages.


Mis à part de s'amuser avec le contours des pays et des départements, on peut afficher tout point GPS pour du géo-marketing par exemple.

En utilisant l'excellente classe d'Arkham46 citée plus haut on peut même rendre l'ensemble interactif dans un formulaire.

A+

Philippe

[vodiem]

he bien tu as eu de la chance toi.

j'avais fait du xml avec flash et je n'ai pas du tout retrouvé la même facilité comme je le vois avec le XMLDOM (que je n'ai pas dans mes références).
j'ai dû rajouter la référence "Microsoft XML, v6.0" et utiliser l'objet "DOMDocument60" et pour info:

Code :

selectNodes("kml/Document/Folder")

=> ca marche plus!
he oui, j'ai perdu du temps avant de découvrir que depuis le XML 4 on n'obtient plus de résutat si le noeud est dans un "namespace".
mais j'ai insisté pour faire ca "proprement", j'ai fait des recherche sur ce namespace qui pose prb à beaucoup et en plus j'ai du apprendre aussi du coup le XPATH...
(tu me diras fallait prendre les premiers XML: v<4)
mais bon, c'était l'occasion de connaitre cette nouvelle class.

la troisième coordonnée correspond bien à l'altitude.

par contre je mets le résultat de la projection de miller directement dans la table ce qui évite un temps de calcul lors de l'affichage.

comme je te l'avais dis je n'ai pas encore d'application immédiate mais cela ouvre des possibilités dans le développement d'application lié à la cartographie, avec une représentation/localisation de données.
mais ce qu'il faut retenir principalement c'est que google fourni un excellent outil avec "google earth" et que l'on peut récupérer ces données.
et que les états ne se limite pas seulement à des tableaux, camembert, diagramme...
(il faut savoir qu'il est possible de faire des batiments/maisons et enregistrer en kml.)

les champs d'applications sont multiples: tourisme, transport, logement, météorologie...

ps: dans un autre registre, j'ai vu recemment le survol de lieu important à partir de mappy en 3D (tout un quartier et pas seulement un batiment), c'est simplement: impressionnant.
c'est vraiment une branche en pleine expansion, d'ici qq temps on pourra visiter la planète en 3D (complet) et couplé avec des sites VRML, il n'y aura plus de limites...

[philben]

Vodiem,

Je vois avec plaisir que tu aimes aussi la carto, un sujet passionnant !

Grand merci à toi

Philippe

[Domi2]

Bonsoir,

Quand je disais que je n'envisageais pas d'application de ce type...

Ma question est :

Est-il envisageable, une fois la carte tracée (ou lors du tracage de la carte), de remplir certains secteurs en différentes couleurs selon des valeurs reprises d'une requête ?

A vous lire, je dirais oui, mais une confirmation serait la bienvenue...

Domi2

[vodiem]

salut Domi2,

oui biensur, c'est d'ailleurs je crois le principal objectif de philben.
mais le remplacement de ligne par un polygone fermé pose le problème que je n'ai pas approfondi: les extrusions et les territoires fragmentés, qui ne sont pas un réel prb mais qu'il faut penser à traiter.
philben devrait pouvoir t'éclaircir sur le sujet.

[Arkham46]

Bonjour à tous,

Très Intéressant ces fichiers kml, le rendu est impeccable.

Pour la classe image qui permetterait de dessiner les cartes sur un formulaire et les rendre interactives :
Je n'utilise plus vraiment la classe image originale (en gdi32), je suis passé à gdiplus (beaucoup plus intéressant car gère le jpeg, les données Exif, et plein d'autres choses).

Donc pour apporter de l'interactivité à ces cartes, je vous propose une classe qui facilite grandement l'utlisation de gdiplus.
Cette classe est en écriture depuis un bon moment et fonctionne plutôt bien même si j'y travaille encore.
Je la mets en pièce jointe quand même dans sa version actuelle.
Il suffit de copier-coller le contenu du fichier dans une nouvelle classe et la nommer ClGdipPlus.
Il faut également la librairie GdiPlus.dll (intégré à XP, à télécharger pour les autrs OS et mettre le fichier dans le même répertoire que le mdb, sans l'enregistrer car ce n'est pas un activex)

Dans un formulaire, le code donné par philben pour les pays deviendrait :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
 
Option Explicit
 
#Const ccCALCRANGES = False
Private Type tXY
   dx As Double
   dy As Double
End Type
Private gdPI As Double
Private gWidth As Long
Private gHeight As Long
Private dZoomX As Double, dZoomY As Double, dRapportXSurY As Double
Private dDecalageX As Double, dDecalageY As Double
Private clGdip As ClGdiPlus
 
Private Sub Form_Load()
   Dim oDb As DAO.Database
   Dim oRs As DAO.Recordset
   Dim asPoints() As String
   Dim i As Long, lColor As Long, lEtendue As Long
   Dim dMinX As Double, dMaxX As Double, dMinY As Double
   Dim tPoint1 As tXY, tPoint2 As tXY
   ' Cration de l'image vierge
   Set clGdip = New ClGdiPlus
    gWidth = clGdip.PointsToPixelsX(Me.ImageMiller.Width)
    gHeight = clGdip.PointsToPixelsY(Me.ImageMiller.Height)
    clGdip.CreateBitmap gWidth, gHeight
    clGdip.FillColor vbWhite
   'Calcul de PI
   gdPI = 4 * Atn(1)
   'Ouverture de la table
   Set oDb = CurrentDb
   Set oRs = oDb.OpenRecordset("tmppays", dbOpenTable)
   '1ère boucle pour déterminer les valeurs extrèmes de la projection
#If ccCALCRANGES Then
   dMinX = 2 ^ 30
   dMinY = 2 ^ 30
   While Not oRs.EOF
      asPoints = Split(oRs!contours, ",")
      For i = 0 To UBound(asPoints()) - 1 Step 2
         tPoint1 = GetXYFromProjMiller(Val(asPoints(i)), Val(asPoints(i + 1)))
         If tPoint1.dx < dMinX Then dMinX = tPoint1.dx
         If tPoint1.dx > dMaxX Then dMaxX = tPoint1.dx
         If tPoint1.dy < dMinY Then dMinY = tPoint1.dy
      Next i
      oRs.MoveNext
   Wend
Debug.Print "dMinX:" & dMinX, "dMaxX:" & dMaxX, "dMinY:" & dMinY
#Else
   dMinX = -3.1415958493831
   dMaxX = 3.14159265358979
   dMinY = -1.98474497464755
#End If
   'Paramètres du dessin
   'Me.DrawWidth = 1
   lColor = vbRed
   'Paramètres de centrage sur l'image
   dRapportXSurY = 1
   dZoomX = (gWidth - 20) / (dMaxX - dMinX) 'Me.ImageMiller.ImageWidth / (dMaxX - dMinX)
   dDecalageX = -(dMinX * dZoomX) + 10
   dZoomY = dZoomX * dRapportXSurY
   dDecalageY = -(dMinY * dZoomY) + 10
   'Dessine le contour des pays selon la projection de Miller
   oRs.MoveFirst
   While Not oRs.EOF
      asPoints = Split(oRs!contours, ",")
      ' Calcul la position des points en pixels
      For i = 0 To UBound(asPoints()) - 1 Step 2
         tPoint1 = GetXYFromProjMiller(Val(asPoints(i)), Val(asPoints(i + 1)))
            asPoints(i) = (dZoomX * tPoint1.dx) + dDecalageX
            asPoints(i + 1) = (dZoomY * tPoint1.dy) + dDecalageY
      Next i
    ' Ajoute un point si nécessaire pour fermer le polygone
    If asPoints(UBound(asPoints()) - 1) <> asPoints(0) Or asPoints(UBound(asPoints())) <> asPoints(1) Then
        ReDim Preserve asPoints(UBound(asPoints()) + 2)
        asPoints(i) = asPoints(0)
        asPoints(i + 1) = asPoints(1)
    End If
    ' Dessine le polygone
    clGdip.DrawPolygon asPoints, , lColor, 1
    ' Crée une région
    clGdip.CreateRegionPolygon oRs!Name, asPoints
 
      oRs.MoveNext
   Wend
   Set oRs = Nothing
   Set oDb = Nothing
 
   ' Dessine un cercle à l'emplacement de la ville d'orléans
   tPoint1 = GetXYFromProjMiller(1.9043, 47.90211) ' Orleans
   tPoint1.dx = (dZoomX * tPoint1.dx) + dDecalageX
   tPoint1.dy = (dZoomY * tPoint1.dy) + dDecalageY
   clGdip.DrawEllipse tPoint1.dx, tPoint1.dy, 5, 5, 1, vbRed, vbGreen, 1
    ' Calcule la taille nécessaire à l'affichage du nom de la ville
    clGdip.DrawText "Orléans" & vbNullChar, CLng(15), "Arial", lLeft, ltop, lRight, lBottom, , , , , , , , , , , , True
    ' Affiche le nom de la ville
    clGdip.DrawText "Orléans", 15, "Arial", CLng(tPoint1.dx), CLng(tPoint1.dy), CLng(tPoint1.dx) + (lRight - lLeft), CLng(tPoint1.dy) + (lBottom - ltop), , , vbBlue, , vbYellow, 100, , True
 
   ' Conserve l'image de base en mémoire
   clGdip.KeepImage
   ' Dessine l'image
   Me.ImageMiller.PictureData = clGdip.GdiPlusToPictureData
 
End Sub
 
Private Sub ImageMiller_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lRegion As String
Dim tPoint As tXY
Dim lCpt As Long
lRegion = clGdip.GetMouseRegion(clGdip.CtrlToImgX(X, Me.ImageMiller), clGdip.CtrlToImgY(Y, Me.ImageMiller))
clGdip.ResetImage
clGdip.FrameRegion lRegion, vbRed, , , 50
Me.ImageMiller.PictureData = clGdip.GdiPlusToPictureData
 
' Affiche le pays survolé
Me.TxtRegion.Value = lRegion
' Calcul la longitude et latitude sous la souris
tPoint.dx = (clGdip.CtrlToImgX(X, Me.ImageMiller) - dDecalageX) / dZoomX
tPoint.dy = (clGdip.CtrlToImgY(Y, Me.ImageMiller) - dDecalageY) / dZoomY
tPoint = GetLonLat(tPoint.dx, tPoint.dy)
' Affiche la longitude et la latitude
Me.TxtLon.Value = tPoint.dx
Me.TxtLat.Value = tPoint.dy
 
End Sub
 
 
Private Function GetXYFromProjMiller(ByVal dLon As Double, ByVal dLat As Double) As tXY
   GetXYFromProjMiller.dx = dLon * gdPI / 180
   GetXYFromProjMiller.dy = -1.25 * Log(Tan(gdPI * (0.25 + dLat / 450)))
End Function
 
Private Function GetLonLat(pX As Double, pY As Double) As tXY
   GetLonLat.dx = pX / gdPI * 180
   GetLonLat.dy = ((Atn(Exp(pY / -1.25)) / gdPI) - 0.25) * 450
End Function

Le principe est simple :
- Je crée un bitmap (CreateBitmap)
- Je dessine dessus (FillColor, DrawPolygon, ...)
- Je l'affiche dans le contrôle (GdiPlusToPictureData)

Au passage j'utilise les fonctions CtrlToImgX/Y et ImgToCtrlX/Y pour passer des coordonnées contrôle vers image et vice-versa.
La classe ClGdip doit recevoir toutes les coordonnées en pixel.

Je n'ai pas Access sous la main, donc c'est fait sous Excel (ça marchait sous Excel mais ma transcription Excel vers Access a peut-être créer des erreurs)

ImageMiller est un contrôle image
TxtRegion est une zone de texte pour afficher le pays sous la souris
TxtLon est une zone de texte pour afficher la longitude sous la souris
TxtLat est une zone de texte pour afficher la latitude sous la souris

La fonction FrameRegion permet d'entourer une région, on peut remplacer par FillRegion pour la remplir, ou HatchRegion pour la hachurer.
(Il faudrait une variable static pour vérifier que la région survolée à changer avant de redessiner l'image pour rien)

J'ai ajouté un cercle (DrawEllipse) à l'emplacement de la ville d'Orléans (coordonnées prise au hasard sur le net, ça a l'air de s'afficher au bon endroit).
On peut également afficher du texte avec Drawtext.

Et pour sauvegarder l'image :
clGdip.SaveFile "C:\MES DOCUMENTS\test.jpg"

Voilà, vous avez ce qu'il faut pour dessiner les cartes dans un formulaire.

Bye.

[philben]

bonjour,

GRAND MERCI à Arkham46 pour la version interactive...

Ca ouvre de très nombreuses possibilités !

La copie d'écran est ici

Philippe