Discussion :

[tom-kun]

Bonjour à tous,

Je possède un formulaire qui permet d'ajouter des arrêts à un trajet. Ces arrêts ont déjà été géolocaliser (via l'API Google Map) et ont été stocké dans une table ADRESSE qui répertories les adresses de mes PRESTATAIRES et des STRUCTURES que l'Association utilise. Mais également des "points de passages" qui vont permettre d'effectuer des pauses durant les longs trajets.

Je vous joint un schéma des différentes tables et de leur relation (MCD "ACCESS")



Actuellement j'ai réussi à afficher dans mon WebBrowser le trajet entre deux points.
J'ai également réussi à calculer la distance et le temps de trajet.
Mais voila je n'ai aucune idée de comment optimiser le trajet via l'option optimize:true et l'utilisation de l'option waypoint à partir des latitudes et longitudes de ma table ADRESSE.

Je maîtrise l'API Google Map et les langages du Web (JavaScript, PHP, HTML) mais pas le langage VBA pour lequel j'apprend depuis un mois maintenant.

J'ai tout d'abord pensé à une solution proposée par un membre du forum qui consiste à optimiser un trajet à partir du problème du voyageur de commerce (théorie des graphes) mais le temps de calcul est trop important pour le nombre d'adresses répertoriées dans la base de données de l'Association. http://www.developpez.net/forums/d11...utiers-etapes/

Pour résumer :

• Calculer un temps de trajet entre X adresses qui seront sélectionnées depuis une base de données : on sélectionner le point de départ puis le point suivant. A chaque nouveau point et donc chaque nouveau enregistrement, on calcul la distance entre ces points pour au final obtenir un temps de parcours correct (voir optimal)
• Afficher la carte de l'API Google Map avec plus que deux points et la fonction optimisées via une URL du type : http://maps.googleapis.com/maps/api/directions/json origin=AdresseDepart&destination=AdresseArrivee&waypoints=optimize:true|AdresseIntermediaire1|AdresseIntermediaire2|AdresseIntermediaire3|&sensor=false etc.

Je conçois que ce sujet est complexe.
Pourriez-vous m'orienter ?

Cordialement.

[Hergi]

Bonjour,

Je ne peux malheureusement pas vous aider pour l'optimisation, car j'en suis à essayer de calculer la distance entre deux points.

A ce sujet, quel code avez-vous utilisé pour obtenir la distance ? Je parviens à visualiser l'information via IE, mais impossible de récupérer automatiquement la distance.

Pourriez-vous mettre votre code à disposition ?

Merci !

[Invité]

bonsoir,

la réponse dépend de plusieurs critères :
1) sélectionner une ou plusieurs sources d'information (google ? Bing Maps ? MapQuest ? OpenRoute ? MapBox ? etc...)
2) utilisation d'adresses postales ou de latitude/longitude pour alimenter la source ?
3) Moyen de transport ?

Voici un exemple dans le cas d'un trajet en voiture entre deux points géocodés via google map (nécessite une apikey de Google)

la fonction de test

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
Public Function testDistdurat()
   Dim lat1 As Double, lon1 As Double, lat2 As Double, lon2 As Double
   Dim s1LatLon As String, s2LatLon As String, Distance As Long, Duree As Long
 
   '75001 Paris
   lat1 = 48.86263
   lon1 = 2.3362934
 
   '06000 Nice   
   lat2 = 43.71199
   lon2 = 7.2382688
 
   s1LatLon = LLtoStr(lat1, lon1)
   s2LatLon = LLtoStr(lat2, lon2)
 
   If GetDistDurat(s1LatLon, s2LatLon, Distance, Duree) Then
      MsgBox "> Distance : " & Format(Distance / 1000, "0.0k\m") & vbCrLf & _
             "> Durée : " & Format(Duree / 86400#, "h\hnn\mi\n") & vbCrLf, _
             vbInformation, "Distance et durée par la route"
   End If
End Function

les fonctions :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public Function GetDistDurat(ByVal start As String, ByVal Dest As String, _
                             ByRef Distance As Long, ByRef Duree As Long) As Boolean
    Const cSrc As String = "GM"
    Const cDebDistance As String = """distance"" : {"
    Const cDebDuree As String = """duration"" : {"
    Const cValue As String = """value"" :"
    Const cFin As String = "},"
    Dim firstVal As String, secondVal As String, lastVal As String
    Dim sRep As String, Url As String


    firstVal = "https://maps.googleapis.com/maps/api/distancematrix/json?origins=" & start
    secondVal = "&destinations=" & Dest
    lastVal = "&mode=car&units=metric&language=fr&key=" & "Mon API KEY Google"


    Url = firstVal & secondVal & lastVal
    sRep = getHTTPreponse(Replace(Url, " ", ""))


    If InStr(sRep, AddQuotes("status") & " : " & AddQuotes("OK")) <> 0 Then
        Distance = Val(getTextBetween(getTextBetween(sRep, cDebDistance, cFin), cValue, cFin))
        Duree = Val(getTextBetween(getTextBetween(sRep, cDebDuree, cFin), cValue, cFin))
        GetDistDurat = True
    End If
End Function


Private Function getHTTPreponse(ByVal sURL As String) As String
    On Error GoTo catch
    Dim objHTTP As Object


    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    objHTTP.Open "GET", sURL, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.Send ""
    getHTTPreponse = objHTTP.responseText
fin:
    Set objHTTP = Nothing
    Exit Function
catch:
    MsgBox "err n°" & Err.Number & vbCrLf & Err.Source, vbExclamation, "getHTTPreponse"
    Resume fin
End Function


'avec séparateur : ,"
Private Function LLtoStr(ByVal l1 As Double, ByVal l2 As Double) As String
    LLtoStr = DbletoStr(l1) & "%2C" & DbletoStr(l2)
End Function


Private Function DbletoStr(ByVal v As Double, Optional ByVal lNbDec As Long = 4) As String
    DbletoStr = LTrim$(Str(Round(v, lNbDec)))
End Function


Private Function AddQuotes(ByVal txt As String) As String
    AddQuotes = Chr(34) & txt & Chr(34)
End Function


'retourne un texte entre deux limites
Private Function getTextBetween(ByVal text As String, ByVal Before As String, Optional ByVal After As String) As String
    On Error Resume Next
    getTextBetween = Split(Split(text, Before)(1), After)(0)
End Function

Résultat attendu :

[Hergi]

Bonjour Galoir,

Merci pour la réponse et le code mis à disposition. Désolé pour le temps à vous répondre, mais il s'agit d'un projet non-prioritaire que j'ai mis de côté jusqu'à ce jour.

Pour répondre aux questions :

1) utilisation d'une seule source (Google)
2) utilisation d'adresses postales (auriez-vous un code adapté ?)
3) voiture

Je pense qu'une partie de mes problèmes vient du fait que je n'ai pas de Apikey Google. Je vais encore investiguer de ce côté.

Salutations