Microsoft 365 formule pour transformer des points lambert2

[ludo170967]

Bonjour à tous,
je voudrais savoir si il est possible d'avoir une formule pour transformer des points lambert 2 en metres en point longitude et latitude
exemple point x et y en mètres

X: 373631
Y: 409436

le résultat Longitude: -073488263
Latitude : 48.64376602

Merci pour votre aide
Ludovic

 

[Dranreb]

Bonjour.
Non, je ne les connaissais même pas, mais j'ai ça qui y ressemble beaucoup.

 

[ludo170967]

Bonjour,
merci pour ton fichier, mais je n'arrive pas a le lire.
Cdlt
Ludovic

 

[Dranreb]

Que ce passe-t-il quand vous tentez de l'ouvrir ?
Notez que je viens seulement de voir que vous dites vouloir l'inverse du calcul qu'il contient: il convertit des données GPS en x et y orthonormés exprimés en kilomètre dans une projection stéréographique. Mais le calcul inverse devrait pouvoir se trouver assez facilement.
Les principales fonctions perso :

Function ProjecStéréo(ByVal Lat As Double, ByVal Lon As Double, _
   Optional ByVal LatRéf = 46.875, Optional ByVal LonRéf As Double = 1.625) As Variant
   Dim XProj As Double, YProj As Double
   CalcProjecStéréo XProj, YProj, Lat, Lon, LatRéf, LonRéf
   ProjecStéréo = Array(XProj, YProj)
   End Function
Sub CalcProjecStéréo(XProj As Double, YProj As Double, ByVal Lat As Double, ByVal Lon As Double, _
      Optional ByVal LatRéf As Double = 46.875, Optional ByVal LonRéf As Double = 1.625)
   Dim CosLatRéf As Double, SinLatRéf As Double, X As Double, Y As Double, Z As Double, Zr As Double, Éch As Double
   Lat = Rad(Lat): Lon = Rad(Lon - LonRéf): LatRéf = Rad(LatRéf): SinLatRéf = Sin(LatRéf): CosLatRéf = Cos(LatRéf)
   Y = Sin(Lat): Z = Cos(Lat): X = Sin(Lon) * Z: Z = Cos(Lon) * Z
   Zr = Z * CosLatRéf + Y * SinLatRéf: Y = Y * CosLatRéf - Z * SinLatRéf
   Éch = 2 / (Zr + 1) * 6368: XProj = X * Éch: YProj = Y * Éch
   End Sub
Function Dist(ByVal Lat1 As Double, ByVal Lon1 As Double, ByVal Lat2 As Double, ByVal Lon2 As Double) As Double
   Lat1 = Rad(Lat1): Lon1 = Rad(Lon1): Lat2 = Rad(Lat2): Lon2 = Rad(Lon2)
   Dist = ACos(Sin(Lat1) * Sin(Lat2) + Cos(Lat1) * Cos(Lat2) * Cos(Lon1 - Lon2)) * 6371
   End Function
Private Function Rad(ByVal Deg As Double) As Double
   Const K = 14964008 / 857374503: Rad = Deg * K
   End Function
Private Function ACos(ByVal X As Double) As Double
   On Error Resume Next
   Const Pi÷2 = 122925461 / 78256779: ACos = Atn(-X / Sqr(1 - X * X)) + Pi÷2
   End Function

 

[ludo170967]

re,
a l'ouverture du fichier il se fige et je ne peux rien faire. je suis obligé d'aller dans le gestionnaire de tache pour le fermer.
De plus en vb je suis nul. j'ai regardé sur internet mais je trouve que des formules pour transformer de point lambert93et moi c'est du lambert2 en mètre
Cdlt

 

[Dranreb]

Je cros que je ne peux guère vous aider, désolé.

 

[piga25]

Bonjour,
Pour les formules voir sur Wikipédia : https://fr.wikipedia.org/wiki/Projection_conique_conforme_de_Lambert

Si un courageux veut bien adapter cela sur Excel.

​

 

[ludo170967]

re,
ok merci pour toutes ces infos.

Cdlt
ludovic

 

[dysorthographie]

Bonjour,

' Définition du type personnalisé pour les coordonnées longitude et latitude
Public Type Coordinates
    Longitude As Double
    Latitude As Double
End Type

' Fonction de conversion Lambert 2 vers WGS84 avec un retour de type "Coordinates"
Function LambertToWGS84(X As Double, Y As Double) As Coordinates
    Dim result As Coordinates
    
    ' Constantes de conversion
    Dim lambda0 As Double
    Dim latiso As Double
    Dim N As Double
    Dim C As Double
    Dim Xs As Double
    Dim Ys As Double
    Dim R As Double
    Dim gamma As Double
    Dim omega As Double
    Dim phi As Double
    
    ' Assignation des constantes (à remplacer par les valeurs appropriées)
    lambda0 = 0.04079234433
    latiso = 0.08181919106
    N = 0.7256077650
    C = 11745793.39
    Xs = 600000
    Ys = 8199695.768
    R = 6378137
    gamma = 1.00335655146887969442
    omega = 0.08181919106
    phi = 49.8333333333333333
    
    ' Conversion Lambert 2 en Lambert 93
    X = X - Xs
    Y = Y - Ys
    Dim LongRad As Double
    Dim LatRad As Double
    LongRad = lambda0 + ATn(X / (C - Y))
    Dim phi_1 As Double
    Dim latiso_1 As Double
    phi_1 = 2 * ATn(Exp(Y / N)) - Pi / 2
    latiso_1 = Log(Tn(Pi / 4 + phi_1 / 2) * ((1 - omega * Sn(phi_1)) / (1 + omega * Sn(phi_1))) ^ (omega / 2))
    
    ' Conversion Lambert 93 en WGS84
    LongRad = LongRad / gamma
    LatRad = ATn(Exp(latiso_1)) * 2 - Pi / 2
    
    ' Attribution des valeurs de longitude et de latitude au résultat
    result.Longitude = LongRad
    result.Latitude = LatRad
    
    LambertToWGS84 = result
End Function

' Exemple d'utilisation
Sub TestLambertToWGS84()
    Dim X As Double
    Dim Y As Double
    Dim coords As Coordinates
    
    X = 373631
    Y = 409436
    
    coords = LambertToWGS84(X, Y)
    
    MsgBox "Longitude: " & coords.Longitude & vbCrLf & "Latitude: " & coords.Latitude
End Sub

 

[ludo170967]

Bonjour,
merci pour le code, mais je suis une bille en macro, et je ne sais pas ce que je dois faire.
je vous joins mon fichier car j'ai plus de 2000 points a transformer.
merci pour votre aide.
Cdlt
Ludovic

 

[piga25]

Bonjour,
Avez vous essayé un convertisseur.
Celui-là vous permet de convertir 1000 points à la fois avec un maximum de 5000 points par jour: https://geofree.fr/gf/coordinateconv.asp#listSys

Moins de 5 mn pour convertir toutes vos données.

Petit plus, vous pouvez avoir un visuel de vos points sur une carte.

 

[ludo170967]

Bonjour à tous,
Merci à tous de m'avoir aidé
Cdlt
Ludovic