Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Access Calcul des distances à vol d'oiseau avec L et l

Calcul des distances à vol d'oiseau avec L et l

8 réponses
Avatar
Guy
Bonjour à tous

Ayant récupéré la new table des communes avec les longitudes et latitudes.

Avez vous une formule a appliquer pour le calcul d'un point à un autre.

C'est simplement pour faire une évaluation rapide pour un transporteur.

De plus ce qui exite pour la france excite t-il la même chose pour certain
pays d'europe
--
Amicalement et merci
Signaler un problème avec ce contenu

8 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Raymond [mvp]
Bonjour.

les tables te conviennent-elles ?

pour calculer les distances il faut aller sur http://www.lion1906.com/
le site actuel n'est pas interactif par access mais en cours de réalisation.
prendre contact avec DELVARRE Lionel qui est un charmant garçon.
voir la page de liens sur http://www.lion1906.com/Pages/Liens.html

--
@+
Raymond Access MVP http://OfficeSystem.Access.free.fr/
Pour débuter sur le forum: http://www.mpfa.info/
Nouvelle base Access des communes françaises avec
longitude, latitude et 13246 sites internet officiels
http://ardecheearth.free.fr/basededonnees.htm


"Guy" <André> a écrit dans le message de news:

| Bonjour à tous
|
| Ayant récupéré la new table des communes avec les longitudes et latitudes.
|
| Avez vous une formule a appliquer pour le calcul d'un point à un autre.
|
| C'est simplement pour faire une évaluation rapide pour un transporteur.
|
| De plus ce qui exite pour la france excite t-il la même chose pour certain
| pays d'europe
| --
| Amicalement et merci
Avatar
Guy
Bonjour Raymond,

Oui les tables me conviennent surtout si j'arrive a effectuer les calculs de
distances

--
Amicalement et merci



Bonjour.

les tables te conviennent-elles ?

pour calculer les distances il faut aller sur http://www.lion1906.com/
le site actuel n'est pas interactif par access mais en cours de réalisation.
prendre contact avec DELVARRE Lionel qui est un charmant garçon.
voir la page de liens sur http://www.lion1906.com/Pages/Liens.html

--
@+
Raymond Access MVP http://OfficeSystem.Access.free.fr/
Pour débuter sur le forum: http://www.mpfa.info/
Nouvelle base Access des communes françaises avec
longitude, latitude et 13246 sites internet officiels
http://ardecheearth.free.fr/basededonnees.htm


"Guy" <André> a écrit dans le message de news:

| Bonjour à tous
|
| Ayant récupéré la new table des communes avec les longitudes et latitudes.
|
| Avez vous une formule a appliquer pour le calcul d'un point à un autre.
|
| C'est simplement pour faire une évaluation rapide pour un transporteur.
|
| De plus ce qui exite pour la france excite t-il la même chose pour certain
| pays d'europe
| --
| Amicalement et merci





Avatar
pgz
Bonjour,

Pour calculer la distance entre 3 points, en navigation on utilise la
loxodromie. Mais on peut faire plus simple en estimant la longueur de l'arc
de cercle passant par ces deux points.

Cette longueur est de Rt*Theta, avec
Theta est l'angle au centre qui intercepte les deux points, et Rt le rayon
moyen de la terre soit 6 378 187 m.

De plus Theta =2* Atn(( Tan(Alpha/2)^2 + Tan(Beta/2)^2)^.5)
Avec Alpha et Beta respectivement et en radian la différence de latitude et
de longitude entre les deux points.

Si tu as la flemme j'ai déjà écrit cette fonction.

Bon courage,
--
pgz
_____________________________




Bonjour à tous

Ayant récupéré la new table des communes avec les longitudes et latitudes.

Avez vous une formule a appliquer pour le calcul d'un point à un autre.

C'est simplement pour faire une évaluation rapide pour un transporteur.

De plus ce qui exite pour la france excite t-il la même chose pour certain
pays d'europe
--
Amicalement et merci


Avatar
Guy
Bonjour à vous PGZ et merci.

Je n'ai pas la flemme mais un manque de compétance donc je veux bien
récupéré cette fonction pour m'éviter de galérer
--
Amicalement et merci



Bonjour,

Pour calculer la distance entre 3 points, en navigation on utilise la
loxodromie. Mais on peut faire plus simple en estimant la longueur de l'arc
de cercle passant par ces deux points.

Cette longueur est de Rt*Theta, avec
Theta est l'angle au centre qui intercepte les deux points, et Rt le rayon
moyen de la terre soit 6 378 187 m.

De plus Theta =2* Atn(( Tan(Alpha/2)^2 + Tan(Beta/2)^2)^.5)
Avec Alpha et Beta respectivement et en radian la différence de latitude et
de longitude entre les deux points.

Si tu as la flemme j'ai déjà écrit cette fonction.

Bon courage,
--
pgz
_____________________________




Bonjour à tous

Ayant récupéré la new table des communes avec les longitudes et latitudes.

Avez vous une formule a appliquer pour le calcul d'un point à un autre.

C'est simplement pour faire une évaluation rapide pour un transporteur.

De plus ce qui exite pour la france excite t-il la même chose pour certain
pays d'europe
--
Amicalement et merci




Avatar
pgz
Bonjour,

Le code est un peu long parce qu'il traite toutes les erreurs possibles dans
le paramétrage des latitudes et longitudes.
La règle adoptée est la latitude varie entre 90° Sud et 90° Nord, par
rapport à l'équateur; et la longitude de 180° Ouest à 180° Est par rapport au
méridien de Greenwich.
La distance renvoyée est en m.

ex d'utilisation:
********************************************************
Sub essai()
Dim strErreur As String, D As Long
D = fctDistance(80, 0, 0, "N", 10, 50, 50, "E", 80, 0, 0, "N", 20, 50, 50,
"E", strErreur)
MsgBox strErreur & vbCrLf & D
End Sub
********************************************************
fonction:
********************************************************
Function fctDistance(DegLat1 As Integer, MinLat1 As Integer, SecLat1 As
Integer, NordSud1 As String, _
DegLong1 As Integer, MinLong1 As Integer, SecLong1 As
Integer, OuestEst1 As String, _
DegLat2 As Integer, MinLat2 As Integer, SecLat2 As
Integer, NordSud2 As String, _
DegLong2 As Integer, MinLong2 As Integer, SecLong2 As
Integer, OuestEst2 As String, _
strErreur As String) As Long

'Calcule la longueur en m de l'arc terrestre entre 2 points suivant leurs
latitudes et longitude
Dim Alpha As Double, Alpha1 As Double, Alpha2 As Double, Beta As Double,
Beta1 As Double, Beta2 As Double, Gamma As Double
Dim str As String
Const Rt As Long = 6378187 'rayon moyen de la terre en m

'vérifier les paramètres
strErreur = ""
Alpha1 = fctDegToRad(DegLat1, MinLat1, SecLat1, NordSud1, "Lat", str)
If str <> "" Then strErreur = "Erreur dans latitude 1 :" & vbCrLf & str &
vbCrLf & vbCrLf
Alpha2 = fctDegToRad(DegLat2, MinLat2, SecLat2, NordSud2, "Lat", str)
If str <> "" Then strErreur = "Erreur dans latitude 2 :" & vbCrLf & str &
vbCrLf & vbCrLf
Beta1 = fctDegToRad(DegLong1, MinLong1, SecLong1, OuestEst1, "Long", str)
If str <> "" Then strErreur = "Erreur dans longitude 1 :" & vbCrLf & str &
vbCrLf & vbCrLf
Beta2 = fctDegToRad(DegLong2, MinLong2, SecLong2, OuestEst2, "Long", str)
If str <> "" Then strErreur = "Erreur dans longitude 1 :" & vbCrLf & str &
vbCrLf & vbCrLf

If strErreur <> "" Then fctDistance = -1: Exit Function

'calculer distance
Alpha = Abs(Alpha1 - Alpha2) 'angle horizontal
Beta = Abs(Beta1 - Beta2) 'angle vertical
Gamma = 2 * Atn((Tan(Alpha / 2) ^ 2 + Tan(Beta / 2) ^ 2) ^ 0.5) 'angle des
deux points
fctDistance = Round(Rt * Gamma, 0) 'longueur de l'arc

End Function
**********************************************************
sous-fonction :
**********************************************************
Function fctDegToRad(Degré As Integer, Minute As Integer, Seconde As
Integer, Sens As String, LatLong As String, sErreur As String) As Double
'convertit une latitude(LatLong = "Lat") ou une longitude(LatLong="Long") en
valeur relative d'angle en radian
'Sens : "N" et "E" --> (+); "S" et "O" --> (-)
'renvoie une valeur 20 si erreur de format et renseigne sErreur
Dim iSens As Integer, Theta As Double, Pi As Double

Pi = 4 * Atn(1)
sErreur = ""
Theta = (Degré + Minute / 60 + Seconde / 3600) * Pi / 180

Select Case LatLong
Case "Lat"
Select Case Sens
Case "N"
iSens = 1
Case "S"
iSens = -1
Case Else
iSens = 21
sErreur = "Erreur 01 : latitude sans 'N' ou 'S'." & vbCrLf
End Select
If Theta > Pi / 2 Then sErreur = sErreur & "Erreur 03 : latitude
supérieure à PI/2." & vbCrLf
Case "Long"
Select Case Sens
Case "E"
iSens = 1
Case "O"
iSens = -1
Case Else
iSens = 21
sErreur = "Erreur 02 : longitude sans 'E' ou 'O'." & vbCrLf
End Select
If Theta > Pi Then sErreur = sErreur & "Erreur 04 : longitude
supérieure à PI." & vbCrLf
Case Else
iSens = 21
sErreur = "Erreur 00 : la demande ne précise ni latitude ni
longitude."
End Select
If Minute > 59 Then sErreur = sErreur & "Erreur 05 : plus de 59 minutes." &
vbCrLf
If Seconde > 598 Then sErreur = sErreur & "Erreur 06 : plus de 59 secondes."
& vbCrLf
fctDegToRad = IIf(Theta * iSens + Abs(iSens) - 1 > 19, 20, Theta * iSens)
End Function
***********************************************************

En espérant que cela t'aide,

PGZ

Avatar
pgz
Modification : 2 distances (DVer et DArc), calcul en km et corrections
d'âneries.

Sub essaifctDistance()
Dim strErreur As String, DVer As Double, DArc As Double
strErreur = fctDistance(0, 0, 0, "N", 0, 0, 0, "E", 0, 0, 0, "N", 180, 0, 0,
"E", DVer, DArc)
MsgBox strErreur & vbCrLf & "DVer : " & DVer & vbCrLf & "DArc : " & DArc
End Sub

Function fctDistance(DegLat1 As Integer, MinLat1 As Integer, SecLat1 As
Integer, NordSud1 As String, _
DegLong1 As Integer, MinLong1 As Integer, SecLong1 As
Integer, OuestEst1 As String, _
DegLat2 As Integer, MinLat2 As Integer, SecLat2 As
Integer, NordSud2 As String, _
DegLong2 As Integer, MinLong2 As Integer, SecLong2 As
Integer, OuestEst2 As String, _
DVer As Double, DArc As Double) As String

'Calcule la longueur en km entre 2 points suivant leurs latitudes et
longitude :
' Corde (DVER) orthodromie (DArc)et renvoie un message d'erreur ou ""
Dim Alpha1 As Double, Alpha2 As Double, Beta1 As Double, Beta2 As Double,
dbl As Double
Dim str As String, strErreur As String
Const Rt As Long = 6378.187, Lambda As Single = 79157 'rayon moyen de la
terre en km et coef de latitude croissante

'vérifier les paramètres
strErreur = ""
Alpha1 = fctDegToRad(DegLat1, MinLat1, SecLat1, NordSud1, "Lat", str)
If str <> "" Then strErreur = "Erreur dans latitude 1 :" & vbCrLf & str &
vbCrLf & vbCrLf
Alpha2 = fctDegToRad(DegLat2, MinLat2, SecLat2, NordSud2, "Lat", str)
If str <> "" Then strErreur = "Erreur dans latitude 2 :" & vbCrLf & str &
vbCrLf & vbCrLf
Beta1 = fctDegToRad(DegLong1, MinLong1, SecLong1, OuestEst1, "Long", str)
If str <> "" Then strErreur = "Erreur dans longitude 1 :" & vbCrLf & str &
vbCrLf & vbCrLf
Beta2 = fctDegToRad(DegLong2, MinLong2, SecLong2, OuestEst2, "Long", str)
If str <> "" Then strErreur = "Erreur dans longitude 1 :" & vbCrLf & str &
vbCrLf & vbCrLf

If Alpha1 = Alpha2 And Beta1 = Beta2 Then strErreur = streurr & "Les
coordonnées des deux points sont identiques!"
If strErreur <> "" Then GoTo Exit_fctDistance

'calculer distance ver de terre
dbl = Sqr((1 - Sin(Alpha1) * Sin(Alpha2) - Cos(Alpha1) * Cos(Alpha2) *
Cos(Beta1 - Beta2)) * 2)
DVer = Round(dbl * Rt, 0)
'calculer distance othodromique
DArc = Round(2 * ArcSinus(dbl / 2) * Rt, 0)

Exit_fctDistance:
fctDistance = strErreur
End Function

Function fctDegToRad(Degré As Integer, Minute As Integer, Seconde As
Integer, Sens As String, _
LatLong As String, sErreur As String) As Double
'convertit une latitude(LatLong = "Lat") ou une longitude(LatLong="Long") en
valeur relative d'angle en radian
'Sens : "N" et "E" --> (+); "S" et "O" --> (-)
'renvoie une valeur 20 si erreur de format et renseigne sErreur
Dim iSens As Integer, Theta As Double

sErreur = ""
Theta = (Degré + Minute / 60 + Seconde / 3600) * Pi / 180

Select Case LatLong
Case "Lat"
Select Case Sens
Case "N"
iSens = 1
Case "S"
iSens = -1
Case Else
iSens = 21
sErreur = "Erreur 01 : latitude sans 'N' ou 'S'." & vbCrLf
End Select
If Theta > Pi / 2 Then sErreur = sErreur & "Erreur 03 : latitude
supérieure à PI/2." & vbCrLf
Case "Long"
Select Case Sens
Case "E"
iSens = 1
Case "O"
iSens = -1
Case Else
iSens = 21
sErreur = "Erreur 02 : longitude sans 'E' ou 'O'." & vbCrLf
End Select
If Theta > Pi Then sErreur = sErreur & "Erreur 04 : longitude
supérieure à PI." & vbCrLf
Case Else
iSens = 21
sErreur = "Erreur 00 : la demande ne précise ni latitude ni
longitude."
End Select
If Minute > 59 Then sErreur = sErreur & "Erreur 05 : plus de 59 minutes." &
vbCrLf
If Seconde > 598 Then sErreur = sErreur & "Erreur 06 : plus de 59 secondes."
& vbCrLf
fctDegToRad = IIf(Theta * iSens + Abs(iSens) - 1 > 19, 20, Theta * iSens)
End Function

Function ArcSinus(X As Double, Optional strErreur As String) As Double
If X > 1 Then strErreur = "Erreur : appel de fonction ArcSinus avec argument
= " & X: Exit Function
ArcSinus = Pi / 2
If X < 1 Then ArcSinus = Atn(X / Sqr(1 - X ^ 2))
End Function

Function Pi() As Double
Pi = 4 * Atn(1)
End Function

--
pgz
_____________________________



"
Avatar
Raymond [mvp]
Bonjour.
erreur sur la ligne:
If Alpha1 = Alpha2 And Beta1 = Beta2 Then strErreur = streurr & "Les
coordonnées des deux points sont identiques!"
remplacer streurr par strErreur , je pense ?

pour me faire plaisir, car je suis d'une flemmardise aigüe, peux-tu ne pas
faire dépasseer tes lignes à 76 caractères lorsque tu places un code sur le
forum ? chaque fois il faut que j'enlève le retour chariot et que je vérifie
le " ".
enfin, si tu y penses, sinon c'est très bien.
--
@+
Raymond Access MVP http://OfficeSystem.Access.free.fr/
Pour débuter sur le forum: http://www.mpfa.info/
Nouvelle base Access des communes françaises avec
longitude, latitude et 13246 sites internet officiels
http://ardecheearth.free.fr/basededonnees.htm


"pgz" a écrit dans le message de news:

| Modification : 2 distances (DVer et DArc), calcul en km et corrections
| d'âneries.
|
| Sub essaifctDistance()
| Dim strErreur As String, DVer As Double, DArc As Double
| strErreur = fctDistance(0, 0, 0, "N", 0, 0, 0, "E", 0, 0, 0, "N", 180, 0,
0,
| "E", DVer, DArc)
| MsgBox strErreur & vbCrLf & "DVer : " & DVer & vbCrLf & "DArc : " & DArc
| End Sub
|
| Function fctDistance(DegLat1 As Integer, MinLat1 As Integer, SecLat1 As
| Integer, NordSud1 As String, _
| DegLong1 As Integer, MinLong1 As Integer, SecLong1 As
| Integer, OuestEst1 As String, _
| DegLat2 As Integer, MinLat2 As Integer, SecLat2 As
| Integer, NordSud2 As String, _
| DegLong2 As Integer, MinLong2 As Integer, SecLong2 As
| Integer, OuestEst2 As String, _
| DVer As Double, DArc As Double) As String
|
| 'Calcule la longueur en km entre 2 points suivant leurs latitudes et
| longitude :
| ' Corde (DVER) orthodromie (DArc)et renvoie un message d'erreur ou ""
| Dim Alpha1 As Double, Alpha2 As Double, Beta1 As Double, Beta2 As Double,
| dbl As Double
| Dim str As String, strErreur As String
| Const Rt As Long = 6378.187, Lambda As Single = 79157 'rayon moyen de la
| terre en km et coef de latitude croissante
|
| 'vérifier les paramètres
| strErreur = ""
| Alpha1 = fctDegToRad(DegLat1, MinLat1, SecLat1, NordSud1, "Lat", str)
| If str <> "" Then strErreur = "Erreur dans latitude 1 :" & vbCrLf & str &
| vbCrLf & vbCrLf
| Alpha2 = fctDegToRad(DegLat2, MinLat2, SecLat2, NordSud2, "Lat", str)
| If str <> "" Then strErreur = "Erreur dans latitude 2 :" & vbCrLf & str &
| vbCrLf & vbCrLf
| Beta1 = fctDegToRad(DegLong1, MinLong1, SecLong1, OuestEst1, "Long", str)
| If str <> "" Then strErreur = "Erreur dans longitude 1 :" & vbCrLf & str &
| vbCrLf & vbCrLf
| Beta2 = fctDegToRad(DegLong2, MinLong2, SecLong2, OuestEst2, "Long", str)
| If str <> "" Then strErreur = "Erreur dans longitude 1 :" & vbCrLf & str &
| vbCrLf & vbCrLf
| ================================================== | If Alpha1 = Alpha2 And Beta1 = Beta2 Then strErreur = streurr & "Les
| coordonnées des deux points sont identiques!"
| If strErreur <> "" Then GoTo Exit_fctDistance
| ================================================== | 'calculer distance ver de terre
| dbl = Sqr((1 - Sin(Alpha1) * Sin(Alpha2) - Cos(Alpha1) * Cos(Alpha2) *
| Cos(Beta1 - Beta2)) * 2)
| DVer = Round(dbl * Rt, 0)
| 'calculer distance othodromique
| DArc = Round(2 * ArcSinus(dbl / 2) * Rt, 0)
|
| Exit_fctDistance:
| fctDistance = strErreur
| End Function
|
| Function fctDegToRad(Degré As Integer, Minute As Integer, Seconde As
| Integer, Sens As String, _
| LatLong As String, sErreur As String) As Double
| 'convertit une latitude(LatLong = "Lat") ou une longitude(LatLong="Long")
en
| valeur relative d'angle en radian
| 'Sens : "N" et "E" --> (+); "S" et "O" --> (-)
| 'renvoie une valeur 20 si erreur de format et renseigne sErreur
| Dim iSens As Integer, Theta As Double
|
| sErreur = ""
| Theta = (Degré + Minute / 60 + Seconde / 3600) * Pi / 180
|
| Select Case LatLong
| Case "Lat"
| Select Case Sens
| Case "N"
| iSens = 1
| Case "S"
| iSens = -1
| Case Else
| iSens = 21
| sErreur = "Erreur 01 : latitude sans 'N' ou 'S'." & vbCrLf
| End Select
| If Theta > Pi / 2 Then sErreur = sErreur & "Erreur 03 : latitude
| supérieure à PI/2." & vbCrLf
| Case "Long"
| Select Case Sens
| Case "E"
| iSens = 1
| Case "O"
| iSens = -1
| Case Else
| iSens = 21
| sErreur = "Erreur 02 : longitude sans 'E' ou 'O'." & vbCrLf
| End Select
| If Theta > Pi Then sErreur = sErreur & "Erreur 04 : longitude
| supérieure à PI." & vbCrLf
| Case Else
| iSens = 21
| sErreur = "Erreur 00 : la demande ne précise ni latitude ni
| longitude."
| End Select
| If Minute > 59 Then sErreur = sErreur & "Erreur 05 : plus de 59 minutes."
&
| vbCrLf
| If Seconde > 598 Then sErreur = sErreur & "Erreur 06 : plus de 59
secondes."
| & vbCrLf
| fctDegToRad = IIf(Theta * iSens + Abs(iSens) - 1 > 19, 20, Theta * iSens)
| End Function
|
| Function ArcSinus(X As Double, Optional strErreur As String) As Double
| If X > 1 Then strErreur = "Erreur : appel de fonction ArcSinus avec
argument
| = " & X: Exit Function
| ArcSinus = Pi / 2
| If X < 1 Then ArcSinus = Atn(X / Sqr(1 - X ^ 2))
| End Function
|
| Function Pi() As Double
| Pi = 4 * Atn(1)
| End Function
|
| --
| pgz
| _____________________________
|
|
|
| "
Avatar
Raymond [mvp]
RE.

j'ai repéré un truc dans ton dernier calcul:
DVer = Round(dbl * Rt, 0)
DArc = Round(2 * ArcSinus(dbl / 2) * Rt, 0)
ne penses-tu pas qu'il faudrait indiquer:
DVer = Round(dbl * Rt, 3)
DArc = Round(2 * ArcSinus(dbl / 2) * Rt, 3)
ce qui permettrait d'obtenir une distance en mètres ?

--
@+
Raymond Access MVP http://OfficeSystem.Access.free.fr/
Pour débuter sur le forum: http://www.mpfa.info/
Nouvelle base Access des communes françaises avec
longitude, latitude et 13246 sites internet officiels
http://ardecheearth.free.fr/basededonnees.htm


"pgz" a écrit dans le message de news: