none
VBA Mappoint calcul d'itinéraire RRS feed

  • Question

  • Bonjour à tous,

    lorsque je calcule l'itinéraire du point A vers le point B (j'ai adapté le code pour calculer l'itinéraire avec les coordonnées GPS (latitude et longitude)) j'obtiens une distance routière en km qui est différente de l'itinéraire entre ce même point B et le point A (itinéraire inverse). Je pense que le logiciel cherche à optimiser le trajet en fonction du temps de trajet alors que je souhaite que le logiciel optimise en fonction du nombre de km parcouru seulement. Je pense qu'il faut rajouter une ligne du type :

    obj.Route.Calculate."minimiser le nombre de km"

    Si quelqu'un aurait la solution sera me serait très utile.

    Merci à vous tous, je vous met mon nouveau code ci dessous:

    Private Sub Distance()
             Dim objApp As New MapPoint.Application
             Dim objMap As MapPoint.Map
             Dim objRoute As MapPoint.Route
             Dim objLoc1 As MapPoint.Location
             Dim objLoc2 As MapPoint.Location
             Set objApp = CreateObject("MapPoint.Application.EU.19")
             objApp.Visible = False
             Set objMap = objApp.NewMap
             Set objRoute = objMap.ActiveRoute
             
              'Limitation des vitesses sur autoroutes et routes
                 objRoute.DriverProfile.Speed(geoRoadInterstate) = 90
                 objRoute.DriverProfile.Speed(geoRoadLimitedAccess) = 80
                 objRoute.DriverProfile.Speed(geoRoadOtherHighway) = 70
                 objRoute.DriverProfile.Speed(geoRoadArterial) = 50
                 objRoute.DriverProfile.Speed(geoRoadStreet) = 30

                
             Worksheets("Feuil1").Cells(1, 7).Value = "Dist routière (kms)"
             Worksheets("Feuil1").Cells(1, 8).Value = "Dist oiseau (kms)"
             Worksheets("Feuil1").Cells(1, 9).Value = "Temps (min)"
             Worksheets("Feuil1").Cells(1, 5).Value = "Loc 2 Latitude"
             Worksheets("Feuil1").Cells(1, 6).Value = "Loc 2 Longitude"
             Worksheets("Feuil1").Cells(1, 3).Value = "Loc 1 Latitude"
             Worksheets("Feuil1").Cells(1, 4).Value = "Loc 1 Longitude"
             NReadRow = 2
             Do While Worksheets("Feuil1").Cells(NReadRow, 2) <> ""
                 'Définition des deux points sur la carte
                 Set objLoc1 = objMap.FindResults(Worksheets("Feuil1").Cells(NReadRow, 1)).Item(1)
                 Set objLoc2 = objMap.FindResults(Worksheets("Feuil1").Cells(NReadRow, 2)).Item(1)
              
                 'Placement des points et calcul de la distance
                 objRoute.Waypoints.Add objLoc1
                 objRoute.Waypoints.Add objLoc2
                 objRoute.Calculate
          
                 'Distance routière entre les deux villes
                 Worksheets("Feuil1").Cells(NReadRow, 7) = objRoute.Distance
                 'Distance à vol d'oiseau
                 Worksheets("Feuil1").Cells(NReadRow, 8) = objMap.Distance(objLoc1, objLoc2)
                 'Temps de trajet
                 Worksheets("Feuil1").Cells(NReadRow, 9) = objRoute.DrivingTime * 24 * 60
                 'Latitude Loc 1
                  Worksheets("Feuil1").Cells(NReadRow, 3) = objLoc1.Latitude
                  'Longitude Loc 1
                   Worksheets("Feuil1").Cells(NReadRow, 4) = objLoc1.Longitude
                 'Latitude Loc 2
                  Worksheets("Feuil1").Cells(NReadRow, 5) = objLoc2.Latitude
                  'Longitude Loc 2
                   Worksheets("Feuil1").Cells(NReadRow, 6) = objLoc2.Longitude
                 objRoute.Clear
                 NReadRow = NReadRow + 1
             Loop
            
            
          objMap.Saved = True
          Set objApp = Nothing
          Set objMap = Nothing
          Set objLoc1 = Nothing
          Set objLoc2 = Nothing
          Set objRoute = Nothing

    End Sub

    vendredi 16 juin 2017 06:21

Toutes les réponses