[Calc] Conversion de coordonnées Géo ou Cartographiques

Vos meilleures macros et portions de code sont publiées dans cette section.
Aucun support sur une question de programmation ici !

Modérateur: Vilains modOOs

Règles du forum
Aucune question dans cette section !
Celle-ci rassemble les meilleures macros et portions de code. Vous pouvez en revanche commenter ou argumenter le code exposé. Vous pouvez même remercier l'auteur (cela fait toujours plaisir) en indiquant par exemple dans quel cadre ou contexte vous en avez eu l'utilité.
Si vous avez à poster quelque chose, faites-le depuis la section Macros et API et demandez à un modérateur de l'y déplacer.

[Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar PK1157 » 30 Jan 2011 22:53

J'ai développé une collection de fonctions Calc permettant les conversions de coordonnées suivantes :
Cartographiques Lambert I, II , II étendu, III, IV vers géographiques NTF et conversion réciproque ;
Géographiques NTF ou Cartographiques Lambert 93 vers WGS84 et conversion réciproque ;
WGS84 vers UTM et Réciproque.
Cela intéresse-t-il quelqu'un ?
- LatIsom et IsomLat sont des fonctions "de cuisine interne" de conversion pour latitude isométrique
- LAMB_LatNTF permet de trouver la latitude géographique NTF à partir d'un couple de coordonnées Lambert I, II , II étendu, III, IV ou 93
- LAMB_LonNTF permet de trouver la longitude géographique NTF à partir d'un couple de coordonnées Lambert I, II , II étendu, III, IV ou 93
- NTF_LatWGS permet de trouver la latitude géographique WGS84 à partir d'un couple de coordonnées géographiques NTF
- NTF_LonWGS permet de trouver la longitude géographique WGS84 à partir d'un couple de coordonnées géographiques NTF
- NTF_XLamb permet de trouver l'"easting" Lambert I, II , II étendu, III, IV ou 93 à partir d'un couple de coordonnées géographiques NTF
- NTF_YLamb permet de trouver le"northing" Lambert I, II , II étendu, III, IV ou 93 à partir d'un couple de coordonnées géographiques NTF
- WGS_LatNTF permet de trouver la latitude géographique NTF à partir d'un couple de coordonnées géographiques WGS84
- WGS_LonNTF permet de trouver la longitude géographique NTF à partir d'un couple de coordonnées géographiques WGS84
- WGS_XL93 et WGS_YL93 convertissent les coordonnées WGS84 en Projection Lambert 93
- L93_LatWgs et L93_LonWgs effectuent la conversion inverse.
- DFCI_LatWGS et DFCI_LonWGS transforment les coordonnées du carré DFCI en coordonées WGS84 quand WGS_DFCI effectue l'inverse.
- DecDMS et DMSDec traduisent des degrés décimaux en Degrés, Minutes, Secondes et réciproquement.
-Utm_LatWGS et Utm_LonWGS permettent de convertir les coordonnées cartographiques UTM en géographiques WGS84
- WGS_FusZonUTM, WGS_UTMEasting et WGS_UTMNorthing effectuent les conversions réciproques.

--- 3 avril 2017 ----
J'ai ajouté la conversion UTM vers MGRS et réciproque à la demande d'un intervenant sur le forum. J'ai été un peu présomptueux dans ma réponse précédente, ça m'a pris plus de temps que prévu ...
J'en ai profité pour corriger quelques erreurs mineures (redondances inutiles) et j'ai pris en compte les particularités de la Norvège et du Svalbard dans le carroyage UTM (et donc MGRS).
La prochaine étape, à la demande de Papyzède, sera de développer les conversions avec les coniques conformes zonées utilisées en France métropolitaine.
à bientôt,
PK1157
PS : le fichier d'exemple et le code ont été mis à jour.
Code : Tout sélectionner   AgrandirRéduire
REM*****BASIC*****

FUNCTION DMSDec(Param AS STRING) AS DOUBLE
   REM Conversion Degrés, Minutes, Secondes en Degrés Décimaux
   REM Vérifié 23 mars 2017
   DIM ok AS BOOLEAN
   DIM x AS STRING
   DIM   neg AS BOOLEAN
   DIM d,m,s,z AS DOUBLE
   DIM DMS(2)
   DIM i as INTEGER
   neg=0
   x=UCASE(TRIM(Param))
   IF LEFT(x,1)="-" THEN
      neg=1: x=MID(x,2,255)
   ENDIF
   IF RIGHT(x,1)="W" THEN neg=1
   IF RIGHT(x,1)="S" THEN neg=1
   IF RIGHT(x,1)="O" THEN neg=1
   ok=1
   WHILE ok<>0
      ok=0
      IF INSTR(x,CHR(8211))>0 THEN
         ok=1: x=REPLACE(x,CHR(8211),"-"): x=TRIM(x)
      ENDIF
      IF INSTR(x,CHR(160))>0 THEN
         ok=1: x=REPLACE(x,CHR(160)," "): x=TRIM(x)
      ENDIF
      IF INSTR(x,"-")>0 THEN
         ok=1: x=REPLACE(x,"-"," "): x=TRIM(x)
      ENDIF
      IF INSTR(x,"N")>0 THEN
         ok=1: x=REPLACE(x,"N","")
      ENDIF
      IF INSTR(x,"S")>0 THEN
         ok=1: x=REPLACE(x,"S","")
      ENDIF
      IF INSTR(x,"E")>0 THEN
         ok=1: x=REPLACE(x,"E","")
      ENDIF
      IF INSTR(x,"W")>0 THEN
         ok=1: x=REPLACE(x,"W","")
      ENDIF
      IF INSTR(x,"O")>0 THEN
         ok=1: x=REPLACE(x,"O","")
      ENDIF
      IF INSTR(x," ")>0 THEN
         ok=1: x=REPLACE(x," ","\")
      ENDIF
      IF INSTR(x,"°")>0 THEN
         ok=1: x=REPLACE(x,"°","\")
      ENDIF
      IF INSTR(x,CHR(34))>0 THEN
         ok=1: x=REPLACE(x,CHR(34),"\")
      ENDIF
      IF INSTR(x,CHR(39))>0 THEN
         ok=1: x=REPLACE(x,CHR(39),"\")
      ENDIF
      IF INSTR(x,CHR(8217))>0 THEN
         ok=1: x=REPLACE(x,CHR(8217),"\")
      ENDIF
      IF INSTR(x,"-")>0 THEN
         ok=1: x=REPLACE(x,"-","\")
      ENDIF
      IF INSTR(x,"+")>0 THEN
         ok=1: x=REPLACE(x,"+","\")
      ENDIF
      IF INSTR(x,"/")>0 THEN
         ok=1: x=REPLACE(x,"/","\")
      ENDIF
      IF INSTR(x,",")>0 THEN
         ok=1: x=REPLACE(x,",",".")
      ENDIF
      IF INSTR(x,"\\")>0 THEN
         ok=1: x=REPLACE(x,"\\","\")
      ENDIF
   WEND
   DMS=SPLIT(x,"\"): d=VAL(DMS(0)): m=VAL(DMS(1)): s=VAL(DMS(2)): z=d+m/60+s/3600
   IF neg THEN z=-z
   IF ABS(d)>180 OR ABS(m)>59 OR INT(ABS(s))>59 THEN z=-9999
   DMSDec=z
END FUNCTION

FUNCTION DecDMS(P1 AS DOUBLE, OPTIONAL P2 AS INTEGER) AS STRING
   REM Conversion Degrés Décimaux en Degrés, Minutes, Secondes
   REM P1: réel à convertir en chaîne
   REM P2: 0 pour Latitude, valeur non nulle pour Longitude
   REM Vérifié 23 mars 2017
   DIM x AS STRING
   DIM   neg AS BOOLEAN
   DIM d,m,s,z AS DOUBLE
   DIM MaxVal as DOUBLE
   z=P1 : MaxVal=180
   IF z<0 THEN
      z=ABS(z): neg=1
   ENDIF
   d=INT(z): z=z-d: z=z*60
   m=INT(z): z=z-m: z=z*60
   s=int((INT(z*1000+0.5)/1000)*10)/10
   x=d & "°" & m & "'" & s & CHR(34)
   IF ISMISSING(P2) THEN
      IF neg THEN x="-" & x
   ELSE
      IF P2=0 THEN
         MaxVal=90
         IF neg THEN x=x & " S" ELSE x=x &" N"
      ELSE
         IF neg THEN x=x & " W" ELSE x=x &" E"
      ENDIF
   ENDIF
   IF ABS(z)>MaxVal THEN DecDMS="Valeur hors bornes !" ELSE DecDMS=x
END FUNCTION

FUNCTION WGSLatNTF(GLat AS DOUBLE, GLon AS DOUBLE) AS DOUBLE
   REM Calcul de la Latitude NTF à partir des coordonnées géographiques WGS84 en Degrés décimaux
   REM GLat, GLon en Degrés décimaux
   REM
   DIM   Phi, Lambda, h, AA, aNTF, aWGS, b, bNTF, bWGS, eNTF, eWGS, e2, v, X, Y, Z, p, r, f,u AS DOUBLE
   REM   ----------------------------------
   REM   Conversions Degrés <---> Radians
   DIM Rad2Deg, Deg2Rad AS DOUBLE
   Rad2Deg=180/PI(): Deg2Rad=PI()/180
   REM   ----------------------------------
   REM h = hauteur sur l'ellipsoïde - mis à zéro
   Phi = GLat*Deg2Rad: Lambda = GLon*Deg2Rad: h = 0
   REM aNTF = Demi Grand-Axe de l'ellipsoïde de Clarke 1880
   aNTF = 6378249.2
   REM bNTF = Demi Petit-Axe de l'ellipsoïde de Clarke 1880
   bNTF = 6356515
   REM eNTF = Première Excentricité de l'ellipsoïde de Clarke 1880
   eNTF = SQR(1 - (bNTF / aNTF)*(bNTF / aNTF))
   REM aWGS = Demi Grand-Axe de l'ellipsoïde WGS84
   aWGS = 6378137
   REM bWGS = Demi Petit-Axe de l'ellipsoïde WGS84
   bWGS = 6356752.314
   REM eWGS = Première Excentricité de l'ellipsoïde WGS84
   eWGS = SQR(1 - ((bWGS / aWGS)*(bWGS / aWGS)))
   AA = aWGS: b=bWGS : e2 = eWGS * eWGS: f = (AA - b) / AA
   v = AA / SQR(1 - e2 * SIN(Phi) * SIN(Phi))
   REM Coordonnée Géocentriques WGS84 : X, Y, Z
   X = (v + h) * COS(Phi) * COS(Lambda)
   Y = (v + h) * COS(Phi) * SIN(Lambda)
   Z = ((1 - e2) * v + h) * SIN(Phi)
   REM Changement de référentiel WGS84 vers NTF
   X = X + 168: Y = Y + 60: Z = Z - 320: AA = aNTF: b = bNTF: e2 = eNTF * eNTF: f = (AA - b) / AA
   p = SQR(X * X + Y * Y): r = p + Z * Z
   u = ATN((Z / p) * ((1 - f) + (e2 * AA / r)))
   Phi = ATN((Z * (1 - f) + e2 * AA * SIN(u) * SIN(u) * SIN(u)) / ((1 - f) * (p - e2 * AA * COS(u) * COS(u) * COS(u))))
   WGSLatNTF=Phi*Rad2Deg
END FUNCTION

FUNCTION WGSLonNTF(GLat AS DOUBLE,GLon AS DOUBLE) AS DOUBLE
   REM Calcul de la Longitude NTF à partir des coordonnées géographiques WGS84 en Degrés décimaux
   REM GLat, GLon en Degrés décimaux
   REM
   DIM Phi, Lambda, h, AA, aWGS, b, bWGS, eWGS, e2, v, X, Y, Z AS DOUBLE
   DIM MeridParis AS DOUBLE
   MeridParis=2.33722916666667*PI()/180
   REM   2°20'14,025" E de Greenwich
      
   REM   ----------------------------------
   REM   Conversions Degrés <---> Radians
   DIM Rad2Deg, Deg2Rad AS DOUBLE
   Rad2Deg=180/PI(): Deg2Rad=PI()/180
   REM   ----------------------------------
   REM h = hauteur sur l'ellipsoïde - mis à zéro
   Phi = GLat*Deg2Rad: Lambda = GLon*Deg2Rad: h = 0
   REM   aWGS = Demi Grand-Axe de l'ellipsoïde WGS84
   aWGS = 6378137
   REM   bWGS = Demi Petit-Axe de l'ellipsoïde WGS84
   bWGS = 6356752.314
   REM   eWGS = Première Excentricité de l'ellipsoïde WGS84
   eWGS = SQR(1 - ((bWGS / aWGS)*(bWGS / aWGS)))
   AA = aWGS: e2 = eWGS * eWGS
   v = AA / SQR(1 - e2 * SIN(Phi) * SIN(Phi))
   REM   Coordonnée Géocentriques WGS84 : X, Y, Z
   X = (v + h) * COS(Phi) * COS(Lambda)
   Y = (v + h) * COS(Phi) * SIN(Lambda)
   Z = ((1 - e2) * v + h) * SIN(Phi)
   REM   Changement de référentiel WGS84 vers NTF
   X = X + 168: Y = Y + 60: Z = Z - 320
   Lambda = ATN(Y / X)
   Lambda=Lambda-MeridParis
   IF X < 0 THEN Lambda = Lambda+PI()
   Lambda=Lambda*Rad2Deg
   WGSLonNTF=Lambda
END FUNCTION

FUNCTION NTFLatWGS(GLat AS DOUBLE,GLon AS DOUBLE) AS DOUBLE
   REM Calcul de la Latitude WGS84 à partir des coordonnées géographiques NTF en Degrés décimaux
   REM GLat, GLon en Degrés décimaux
   REM
   DIM Phi, Lambda, h, AA, aNTF, aWGS, b, bNTF, bWGS, eNTF, eWGS, e2, v, X, Y, Z, p, r, f, u AS DOUBLE
   REM h = hauteur sur l'ellipsoïde - mis à zéro
   DIM MeridParis AS DOUBLE
   MeridParis=2.33722916666667
   REM   2°20'14,025" E de Greenwich
      
   REM   ----------------------------------
   REM   Conversions Degrés <---> Radians
   DIM Rad2Deg, Deg2Rad AS DOUBLE
   Rad2Deg=180/PI(): Deg2Rad=PI()/180
   REM   ----------------------------------   
   Phi = GLat*Deg2Rad: Lambda = (GLon+MeridParis)*Deg2Rad: h = 0
   REM aNTF = Demi Grand-Axe de l'ellipsoïde de Clarke 1880
   aNTF = 6378249.2
   REM bNTF = Demi Petit-Axe de l'ellipsoïde de Clarke 1880
   bNTF = 6356515
   REM eNTF = Première Excentricité de l'ellipsoïde de Clarke 1880
   eNTF = SQR(1 - (bNTF / aNTF)*(bNTF / aNTF))
   REM aWGS = Demi Grand-Axe de l'ellipsoïde WGS84
   aWGS = 6378137
   REM bWGS = Demi Petit-Axe de l'ellipsoïde WGS84
   bWGS = 6356752.314
   REM eWGS = Première Excentricité de l'ellipsoïde WGS84
   eWGS = SQR(1 - (bWGS / aWGS)*(bWGS / aWGS))
   AA = aNTF: e2 = eNTF * eNTF: f = (AA - b) / AA
   v = AA / SQR(1 - e2 * SIN(Phi) * SIN(Phi))
   REM Coordonnée Géocentriques NTF : X, Y, Z
   X = (v + h) * COS(Phi) * COS(Lambda)
   Y = (v + h) * COS(Phi) * SIN(Lambda)
   Z = ((1 - e2) * v + h) * SIN(Phi)
   REM Changement de référentiel NGF vers WGS84
   X = X - 168: Y = Y - 60: Z = Z + 320: AA = aWGS: b = bWGS: e2 = eWGS * eWGS: f = (AA - b) / AA
   p = SQR(X * X + Y * Y): r = p + Z * Z
   u = ATN((Z / p) * ((1 - f) + (e2 * AA / r)))
   Phi = ATN((Z * (1 - f) + e2 * AA * SIN(u) * SIN(u) * SIN(u)) / ((1 - f) * (p - e2 * AA * COS(u) * COS(u) * COS(u))))
   NTFLatWGS=Phi*Rad2Deg
END FUNCTION

FUNCTION NTFLonWGS(GLat AS DOUBLE,GLon AS DOUBLE) AS DOUBLE
   REM Calcul de la Longitude WGS84 à partir des coordonnées géographiques NTF en Degrés décimaux
   REM GLat, GLon en Degrés décimaux
   REM
   DIM Phi, Lambda, h, AA, aNTF, b, bNTF, eNTF, e2, v, X, Y, Z, f, u AS DOUBLE
   DIM MeridParis AS DOUBLE
   MeridParis=2.33722916666667
   REM   2°20'14,025" E de Greenwich
      
   REM   ----------------------------------
   REM   Conversions Degrés <---> Radians
   DIM Rad2Deg, Deg2Rad AS DOUBLE
   Rad2Deg=180/PI(): Deg2Rad=PI()/180
   REM   ----------------------------------   
      
   REM h = hauteur sur l'ellipsoïde - mis à zéro
   Phi = GLat*Deg2Rad: Lambda = (GLon+MeridParis)*Deg2Rad: h = 0
   REM aNTF = Demi Grand-Axe de l'ellipsoïde de Clarke 1880
   aNTF = 6378249.2
   REM bNTF = Demi Petit-Axe de l'ellipsoïde de Clarke 1880
   bNTF = 6356515
   REM eNTF = Première Excentricité de l'ellipsoïde de Clarke 1880
   eNTF= SQR(1 - (bNTF / aNTF)*(bNTF / aNTF))
   AA = aNTF: e2 = eNTF * eNTF: f = (AA - b) / AA
   v = AA / SQR(1 - e2 * SIN(Phi) * SIN(Phi))
   REM Coordonnée Géocentriques NTF : X, Y, Z
   X = (v + h) * COS(Phi) * COS(Lambda)
   Y = (v + h) * COS(Phi) * SIN(Lambda)
   Z = ((1 - e2) * v + h) * SIN(Phi)
   REM Changement de référentiel NTF vers WGS84
   X = X - 168: Y = Y - 60: Z = Z + 320
   Lambda = ATN(Y / X)
   IF X < 0 THEN Lambda = Lambda + PI()
   NTFLonWGS=Lambda*Rad2Deg
END FUNCTION

FUNCTION LatIsom(LatitDec AS DOUBLE, OPTIONAL PremExcEllips AS DOUBLE) AS DOUBLE
   REM LatitDec : Latitude Géographique en Degrés Décimaux
   REM PremExEllips : Première excentricité de l'ellipsoïde (par Défaut, IAG/GRS 1980 pour WGS84)
   DIM   Clarke1880 AS DOUBLE
   DIM   IagGrs80 AS DOUBLE
   DIM LatitRad,s,s2,L AS DOUBLE
   Clarke1880=0.08248325676342
   IagGrs80=0.081819191042815
   REM   ----------------------------------
   REM   Conversions Degrés <---> Radians
   DIM Rad2Deg, Deg2Rad AS DOUBLE
   Rad2Deg=180/PI(): Deg2Rad=PI()/180
   REM   ----------------------------------   
   LatitRad=LatitDec*Deg2Rad
   IF ISMISSING(PremExcEllips) THEN PremExcEllips=IagGrs80
   s = PremExcEllips * SIN(LatitRad)
   s=(1-s)/(1+s)
   s=LOG(s)
   s=s*(PremExcEllips / 2)
   s=EXP(s)
   s2 = TAN(PI()/4+LatitRad / 2)
   s=s2 * s
   L=LOG(s)
   LatIsom=L
END FUNCTION

FUNCTION IsomLat(LatitIsom AS DOUBLE, OPTIONAL PremExcEllips AS DOUBLE, OPTIONAL TolConverg AS DOUBLE) AS DOUBLE
   REM PremExEllips : Première excentricité de l'ellipsoïde (par Défaut, IAG/GRS 1980 pour WGS84)
   DIM   Clarke1880 AS DOUBLE
   DIM   IagGrs80 AS DOUBLE
   Clarke1880=0.08248325676342
   IagGrs80=0.081819191042815
   DIM s0, s1, d, EL, rPremEx, rTolConv AS DOUBLE
   REM   ----------------------------------
   REM   Conversions Degrés <---> Radians
   DIM Rad2Deg, Deg2Rad AS DOUBLE
   Rad2Deg=180/PI(): Deg2Rad=PI()/180
   REM   ----------------------------------   
   EL=EXP(LatitIsom)
   IF ISMISSING(PremExcEllips) THEN rPremEx=IagGrs80 ELSE rPremEx=PremExcEllips
   IF ISMISSING(TolConverg) THEN rTolConv=0.00000000001 ELSE rTolConv=TolConverg
   s1 = 2 * ATN(EL)-PI()/2
   WHILE (ABS(s0 - s1)) > TolConverg
      s0 = s1
rem      d = ((1 + PremExcEllips * SIN(s0)) / (1 - PremExcEllips * SIN(s0)))^(PremExcEllips / 2)
      d = LOG(((1 + PremExcEllips * SIN(s0)) / (1 - PremExcEllips * SIN(s0))))
      d = EXP(d*(PremExcEllips / 2))
      s1 = 2 * ATN(d*el)-PI()/2
   WEND
   IsomLat=s1*Rad2Deg
END FUNCTION

FUNCTION NTFYLamb(GLat AS DOUBLE,GLon AS DOUBLE,OPTIONAL TypLamb AS INTEGER) AS DOUBLE
   DIM LIsom, n, c, Xs, Ys, Y AS DOUBLE
   DIM Clarke1880 AS DOUBLE
   DIM TL AS INTEGER
   REM   ----------------------------------
   REM   Conversions Degrés <---> Radians
   DIM Rad2Deg, Deg2Rad AS DOUBLE
   Rad2Deg=180/PI(): Deg2Rad=PI()/180
   REM   ----------------------------------   
   IF ISMISSING(TypLamb) THEN TL=0 ELSE TL=TypLamb
   Clarke1880=0.08248325676342
   LIsom=LatIsom(GLat,Clarke1880)
   REM   Lambert II étendu par défaut
   SELECT CASE TL
      CASE 1
         n = 0.7604059656: c = 11603796.98: Xs = 600000: Ys = 5657616.674
      CASE 2
         n = 0.7289686274: c = 11745793.39: Xs = 600000: Ys = 6199695.768
      CASE 3
         n = 0.6959127966: c = 11947992.52: Xs = 600000: Ys = 6791905.085
      CASE 4
         n = 0.6712679322: c = 12136281.99: Xs = 234.358: Ys = 7239161.542
      CASE ELSE
         n = 0.7289686274: c = 11745793.39: Xs = 600000: Ys = 8199695.768
   END SELECT
   Y=Ys - c * EXP(-n * LIsom) * COS(n * GLon*Deg2Rad)
   Y=INT(Y+0.5)
   NTFYLamb=Y
END FUNCTION

FUNCTION NTFXLamb(GLat AS DOUBLE,GLon AS DOUBLE,OPTIONAL TypLamb AS INTEGER) AS DOUBLE
   DIM LIsom, n, c, Xs, Ys, X AS DOUBLE
   DIM Clarke1880 AS DOUBLE
   DIM TL AS INTEGER
   REM   ----------------------------------
   REM   Conversions Degrés <---> Radians
   DIM Rad2Deg, Deg2Rad AS DOUBLE
   Rad2Deg=180/PI(): Deg2Rad=PI()/180
   REM   ----------------------------------   
   IF ISMISSING(TypLamb) THEN TL=0 ELSE TL=TypLamb
   Clarke1880=0.08248325676342
   LIsom=LatIsom(GLat,Clarke1880)
   REM   Lambert II étendu par défaut
   SELECT CASE TypLamb
      CASE 1
         n = 0.7604059656: c = 11603796.98: Xs = 600000: Ys = 5657616.674
      CASE 2
         n = 0.7289686274: c = 11745793.39: Xs = 600000: Ys = 6199695.768
      CASE 3
         n = 0.6959127966: c = 11947992.52: Xs = 600000: Ys = 6791905.085
      CASE 4
         n = 0.6712679322: c = 12136281.99: Xs = 234.358: Ys = 7239161.542
      CASE ELSE
         n = 0.7289686274: c = 11745793.39: Xs = 600000: Ys = 8199695.768
   END SELECT
   X=Xs + c * EXP(-n * LIsom) * SIN(n * GLon*Deg2Rad)
   X=INT(X+0.5)
   NTFXLamb=X
END FUNCTION

FUNCTION LambLatNTF(XLambert AS DOUBLE,YLambert AS DOUBLE,TypLamb AS INTEGER) AS DOUBLE
   DIM Clarke1880 AS DOUBLE
   DIM e,LY, R, L, n, c, Xs, Ys AS DOUBLE
   DIM TL AS INTEGER
   REM   ----------------------------------
   REM   Conversions Degrés <---> Radians
   DIM Rad2Deg, Deg2Rad AS DOUBLE
   Rad2Deg=180/PI(): Deg2Rad=PI()/180
   REM   ----------------------------------   
   IF ISMISSING(TypLamb) THEN TL=0 ELSE TL=TypLamb
   Clarke1880=0.08248325676342
   e=Clarke1880
   REM   Lambert II étendu par défaut
   SELECT CASE TypLamb
      CASE 1
         n = 0.7604059656: c = 11603796.98: Xs = 600000: Ys = 5657616.674
      CASE 2
         n = 0.7289686274: c = 11745793.39: Xs = 600000: Ys = 6199695.768
      CASE 3
         n = 0.6959127966: c = 11947992.52: Xs = 600000: Ys = 6791905.085
      CASE 4
         n = 0.6712679322: c = 12136281.99: Xs = 234.358: Ys = 7239161.542
      CASE ELSE
         n = 0.7289686274: c = 11745793.39: Xs = 600000: Ys = 8199695.768
   END SELECT
   R = SQR((XLambert-Xs)*(XLambert-Xs) + (YLambert-Ys)*(YLambert-Ys))
   L = -1 / n * LOG(ABS(R/c))
   LY=IsomLat(L, e, 0.00000000001)
   LambLatNTF=LY
END FUNCTION

FUNCTION LambLonNTF(XLambert AS DOUBLE,YLambert AS DOUBLE,TypLamb AS INTEGER) AS DOUBLE
   DIM LX, R, g, n, c, Xs, Ys AS DOUBLE
   DIM TL AS INTEGER
   REM   ----------------------------------
   REM   Conversions Degrés <---> Radians
   DIM Rad2Deg, Deg2Rad AS DOUBLE
   Rad2Deg=180/PI(): Deg2Rad=PI()/180
   REM   ----------------------------------   
   DIM MeridParis AS DOUBLE
   MeridParis=2.33722916666667
   REM   2°20'14,025" E de Greenwich
   IF ISMISSING(TypLamb) THEN TL=0 ELSE TL=TypLamb
   REM   Lambert II étendu par défaut
   SELECT CASE TypLamb
      CASE 1
         n = 0.7604059656: c = 11603796.98: Xs = 600000: Ys = 5657616.674
      CASE 2
         n = 0.7289686274: c = 11745793.39: Xs = 600000: Ys = 6199695.768
      CASE 3
         n = 0.6959127966: c = 11947992.52: Xs = 600000: Ys = 6791905.085
      CASE 4
         n = 0.6712679322: c = 12136281.99: Xs = 234.358: Ys = 7239161.542
      CASE ELSE
         n = 0.7289686274: c = 11745793.39: Xs = 600000: Ys = 8199695.768
   END SELECT
   R = SQR((XLambert-Xs)*(XLambert-Xs) + (YLambert-Ys)*(YLambert-Ys))
   g = ATN((XLambert-Xs) / (Ys-YLambert))
   LX= g / n
   LX=LX*Rad2Deg
   LambLonNTF=LX
END FUNCTION

FUNCTION WgsXL93(GLat AS DOUBLE,GLon AS DOUBLE) AS DOUBLE
   DIM X93, IagGrs80, rAWGS, ra, re, rn, rcc, rys, rRgl, rRgl0, rRgl1, rRgl2 AS DOUBLE
   DIM rlc,rl,rPhi,rPhi0,rPhi1,rPhi2,rx0,rRy0,rgN1,rgN2 AS DOUBLE
   REM   ----------------------------------
   REM   Conversions Degrés <---> Radians
   DIM Rad2Deg, Deg2Rad AS DOUBLE
   Rad2Deg=180/PI(): Deg2Rad=PI()/180
   REM   ----------------------------------   
   REM   système WGS84
   IagGrs80=0.081819191042815
   rAWGS=6378137
   
   ra=rAWGS : REM   demi grand axe de l'ellipsoïde (m)
   re=IagGrs80: REM   première excentricité de l'ellipsoïde
   REM   paramètres de projection
   rlc=3*deg2rad:    REM   Méridien central : Lambda0 = 3° Est de Greenwich pour Lambert93
   rPhi0=46.5*Deg2Rad:    REM   latitude Origine pour Lambert93
   rPhi1=44*Deg2Rad:    REM   1er parallèle automécoïque
   rPhi2=49*Deg2Rad:    REM   2ème parallèle automécoïque
   
   REM   coordonnées à l'origine
   rx0=700000: rRy0=6600000
   REM   coordonnées du point à traduire
   rPhi=GLat*Deg2Rad: rl=GLon*Deg2Rad
   REM   calcul des grandes normales
   rgN1=ra/SQR(1-re*re*SIN(rPhi1)*SIN(rPhi1))
   rgN2=ra/SQR(1-re*re*SIN(rPhi2)*SIN(rPhi2))
   REM calcul des latitudes isométriques
   rRgl1=LOG(TAN(PI()/4+rPhi1/2)*EXP(LOG((1-re*SIN(rPhi1))/(1+re*SIN(rPhi1)))*re/2)
   rRgl2=LOG(TAN(PI()/4+rPhi2/2)*EXP(LOG((1-re*SIN(rPhi2))/(1+re*SIN(rPhi2)))*re/2)
   rRgl0=LOG(TAN(PI()/4+rPhi0/2)*EXP(LOG((1-re*SIN(rPhi0))/(1+re*SIN(rPhi0)))*re/2)
   rRgl=LOG(TAN(PI()/4+rPhi/2)*EXP(LOG((1-re*SIN(rPhi))/(1+re*SIN(rPhi)))*re/2)
   REM   calcul de l'exposant de la projection
   rn=(LOG((rgN2*COS(rPhi2))/(rgN1*COS(rPhi1))))/(rRgl1-rRgl2)
   REM   calcul de la constante de projection
   rcc=((rgN1*COS(rPhi1))/rn)*EXP(rn*rRgl1)
   X93=rx0+rcc*EXP(-1*rn*rRgl)*SIN(rn*(rl-rlc))
   WgsXL93=X93
END FUNCTION

FUNCTION WgsYL93(GLat AS DOUBLE,GLon AS DOUBLE) AS DOUBLE
   DIM Y93, IagGrs80, rAWGS, ra, re, rn, rcc, rys, rRgl, rRgl0, rRgl1, rRgl2 AS DOUBLE
   DIM rlc,rl,rPhi,rPhi0,rPhi1,rPhi2,rx0,rRy0,rgN1,rgN2 AS DOUBLE
   REM   ----------------------------------
   REM   Conversions Degrés <---> Radians
   DIM Rad2Deg, Deg2Rad AS DOUBLE
   Rad2Deg=180/PI(): Deg2Rad=PI()/180
   REM   ----------------------------------   
   REM   système WGS84
   IagGrs80=0.081819191042815
   rAWGS=6378137
   
   ra=rAWGS : REM   demi grand axe de l'ellipsoïde (m)
   re=IagGrs80: REM   première excentricité de l'ellipsoïde
   REM   paramètres de projection
   rlc=3*deg2rad:    REM   Méridien central : Lambda0 = 3° Est de Greenwich pour Lambert93
   rPhi0=46.5*Deg2Rad:    REM   latitude Origine pour Lambert93
   rPhi1=44*Deg2Rad:    REM   1er parallèle automécoïque
   rPhi2=49*Deg2Rad:    REM   2ème parallèle automécoïque
   
   REM   coordonnées à l'origine
   rx0=700000: rRy0=6600000
   REM   coordonnées du point à traduire
   rPhi=GLat*Deg2Rad: rl=GLon*Deg2Rad
   REM   calcul des grandes normales
   rgN1=ra/SQR(1-re*re*SIN(rPhi1)*SIN(rPhi1))
   rgN2=ra/SQR(1-re*re*SIN(rPhi2)*SIN(rPhi2))
   REM calcul des latitudes isométriques
   rRgl1=LOG(TAN(PI()/4+rPhi1/2)*EXP(LOG((1-re*SIN(rPhi1))/(1+re*SIN(rPhi1)))*re/2)
   rRgl2=LOG(TAN(PI()/4+rPhi2/2)*EXP(LOG((1-re*SIN(rPhi2))/(1+re*SIN(rPhi2)))*re/2)
   rRgl0=LOG(TAN(PI()/4+rPhi0/2)*EXP(LOG((1-re*SIN(rPhi0))/(1+re*SIN(rPhi0)))*re/2)
   rRgl=LOG(TAN(PI()/4+rPhi/2)*EXP(LOG((1-re*SIN(rPhi))/(1+re*SIN(rPhi)))*re/2)
   REM   calcul de l'exposant de la projection
   rn=(LOG((rgN2*COS(rPhi2))/(rgN1*COS(rPhi1))))/(rRgl1-rRgl2)
   REM   calcul de la constante de projection
   rcc=((rgN1*COS(rPhi1))/rn)*EXP(rn*rRgl1)
   REM   calcul des coordonnées Lambert93
   X93=rx0+rcc*EXP(-1*rn*rRgl)*SIN(rn*(rl-rlc))
   rys=rRy0+rcc*EXP(-1*rn*rRgl0)
   Y93=rys-rcc*EXP(-1*rn*rRgl)*COS(rn*(rl-rlc))
   WgsYL93=Y93
END FUNCTION

FUNCTION L93LatWGS(XLambert AS DOUBLE,YLambert AS DOUBLE) AS DOUBLE
   DIM IagGrs80 AS DOUBLE
   DIM e,LY, R, L, n, c, Xs, Ys AS DOUBLE
   REM   ----------------------------------
   REM   Conversions Degrés <---> Radians
   DIM Rad2Deg, Deg2Rad AS DOUBLE
   Rad2Deg=180/PI(): Deg2Rad=PI()/180
   REM   ----------------------------------   
   IagGrs80=0.081819191042815
   n = 0.725607765:c = 11754255.426:Xs = 700000:Ys = 12655612.05: e=IagGrs80
   R = SQR((XLambert-Xs)*(XLambert-Xs) + (YLambert-Ys)*(YLambert-Ys))
   L = -1 / n * LOG(Abs(R/c))
   LY=IsomLat(L, e, 0.00000000001)
   L93LatWGS=LY
END FUNCTION

FUNCTION L93LonWGS(XLambert AS DOUBLE,YLambert AS DOUBLE) AS DOUBLE
   DIM LX, R, g, n, c, Xs, Ys AS DOUBLE
   REM   ----------------------------------
   REM   Conversions Degrés <---> Radians
   DIM Rad2Deg, Deg2Rad AS DOUBLE
   Rad2Deg=180/PI(): Deg2Rad=PI()/180
   REM   ----------------------------------   
   n = 0.725607765: c = 11754255.426: Xs = 700000: Ys = 12655612.05
   R = SQR((XLambert-Xs)*(XLambert-Xs) + (YLambert-Ys)*(YLambert-Ys))
   g = ATN((XLambert-Xs) / (Ys-YLambert))
   LX= g / n
   LX=LX*Rad2Deg+3:    REM   Méridien central : Lambda0 = 3° Est de Greenwich pour Lambert93
   L93LonWGS=LX
END FUNCTION

FUNCTION WGS_FusZonUTM(LatWGS AS DOUBLE, LonWGS as DOUBLE) AS STRING
   DIM GabZon AS STRING
   DIM LettreZon AS STRING
   DIM NumFus AS DOUBLE

   GabZon="CDEFGHJKLMNPQRSTUVWXX"
   NumFus=INT((LonWGS+180)/6)+1
   IF LatWGS>=84 THEN
      REM Arctique
      IF NumFus<31 THEN LettreZon="Y" ELSE  LettreZon="Z"
   ELSE
      IF LatWGS<=-80 THEN
         REM Antarctique
         IF NumFus<31 THEN LettreZon="A" ELSE  LettreZon="B"
      ELSE
         REM Cas General
         LettreZon=MID(GabZon,INT((LatWGS+80)/8)+1,1)
         IF LatWGS>=56 AND LatWGS<64 AND LonWGS>=0 AND LonWGS<12 THEN
            REM Exception Norvege
            IF LonWGS>=3 THEN NumFus=32 ELSE NumFus=31
         ENDIF
         IF LatWGS>=72 AND LatWGS<84 AND LonWGS>=0 AND LonWGS<42 THEN
            REM Exception Svalbard
            NumFus=31+2*INT((LonWGS+3)/12)
         ENDIF
      ENDIF
   ENDIF
   WGS_FusZonUTM=FORMAT(NumFus,"00") & LettreZon
END FUNCTION

FUNCTION WGS_UTMEasting(LatWGS AS DOUBLE, LonWGS as DOUBLE) AS DOUBLE
   DIM aWGS, PrExcWGS AS DOUBLE
   DIM PrExc2, PrExc4, PrExc6 AS DOUBLE
   DIM Lambda, Phi, SinPhi, S2, CosPhi, C2, TanPhi, T2, C AS DOUBLE
   DIM Lambda0 AS DOUBLE
   DIM A, A2,A3, A4, A5, A6 AS DOUBLE
   DIM k0, k1, k2, k3, k4 AS DOUBLE
   DIM sPhi, vPhi, tPhi, E AS DOUBLE
   REM   ----------------------------------
   REM   Conversions Degrés <---> Radians
   DIM Rad2Deg, Deg2Rad AS DOUBLE
   Rad2Deg=180/PI(): Deg2Rad=PI()/180
   REM   ----------------------------------   
   aWGS=6378137 : REM Rayon Equatorial de l'Ellipsoïde IAG/GRS80
   PrExcWGS=0.0818191910428152 : REM Première Excentricité de l'Ellipsoïde IAG/GRS80
   PrExc2=PrExcWGS*PrExcWGS : PrExc4=PrExc2*PrExc4 : PrExc6=PrExc4*PrExc4
   Lambda=LonWGS*Deg2Rad : Phi=LatWGS*Deg2Rad : SinPhi=SIN(Phi) : S2=SinPhi*SinPhi : CosPhi=COS(Phi) : C2=CosPhi*CosPhi : TanPhi=TAN(Phi) : T2=TanPhi*TanPhi
   Lambda0=INT((LonWGS+180)/6)+1 : REM Fuseau UTM
   Lambda0=6*Lambda0-183 : REM Méridien de Référence de la Projection
   REM ------------ Prise en compte particularites grille UTM 03/04/2017 --
   IF LatWGS>=56 AND LatWGS<64 AND LonWGS>=0 AND LonWGS<12 THEN
      REM Exception Norvege
      IF LonWGS>=3 THEN Lambda0=7.5 ELSE Lambda0=1.5
   ENDIF
   IF LatWGS>=72 AND LatWGS<84 AND LonWGS>=0 AND LonWGS<42 THEN
      REM Exception Svalbard
      Lambda0=4.5
      IF LonWGS>=9 THEN Lambda0=15
      IF LonWGS>=21 THEN Lambda0=27
      IF LonWGS>=33 THEN Lambda0=37.5
   ENDIF
   REM --------------------------------------------------------------------
   Lambda0=Lambda0*Deg2Rad : REM en Radians !
   A=(Lambda-Lambda0)*CosPhi
   A2=A*A : A3=A*A2 : A4=A*A3 : A5=A*A4 : A6=A*A5
   k0=0.9996
   k1=1-PrExc2/4-3*PrExc4/64-5*PrExc6/256
   k2=3*PrExc2/8+3*PrExc4/32+45*PrExc6/1024
   k3=15*PrExc4/256+45*PrExc6/1024
   k4=35*PrExc6/3072
   C=PrExc2/(1-PrExc2)*C2
   sPhi=k1*Phi-k2*SIN(2*Phi)+k3*SIN(4*Phi)-k4*SIN(6*Phi)
   vPhi=1/SQR(1-PrExc2*S2)
   tPhi=TanPhi*(A2/2+(5-T2+9*C+4*C*C)*A4/24+(61-58*T2+T2*T2)*A6/720)
   E=500000+k0*aWGS*vPhi*(A+(1-T2+C)*A3/6+(5-18*T2+T2*T2)*A5/120)
   WGS_UTMEasting=INT(E*10+0.5)/10
END FUNCTION

FUNCTION WGS_UTMNorthing(LatWGS AS DOUBLE, LonWGS as DOUBLE) AS DOUBLE
   DIM aWGS, PrExcWGS AS DOUBLE
   DIM PrExc2, PrExc4, PrExc6 AS DOUBLE
   DIM Lambda, Phi, SinPhi, S2, CosPhi, C2, TanPhi, T2, C AS DOUBLE
   DIM Lambda0 AS DOUBLE
   DIM A, A2,A3, A4, A5, A6 AS DOUBLE
   DIM k0, k1, k2, k3, k4 AS DOUBLE
   DIM sPhi, vPhi, tPhi, N, Nz AS DOUBLE
   REM   ----------------------------------
   REM   Conversions Degrés <---> Radians
   DIM Rad2Deg, Deg2Rad AS DOUBLE
   Rad2Deg=180/PI(): Deg2Rad=PI()/180
   REM   ----------------------------------   
   aWGS=6378137 : REM Rayon Equatorial de l'Ellipsoïde IAG/GRS80
   PrExcWGS=0.0818191910428152 : REM Première Excentricité de l'Ellipsoïde IAG/GRS80
   PrExc2=PrExcWGS*PrExcWGS : PrExc4=PrExc2*PrExc2 : PrExc6=PrExc2*PrExc4
   Lambda=LonWGS*Deg2Rad : Phi=LatWGS*Deg2Rad : SinPhi=SIN(Phi) : S2=SinPhi*SinPhi : CosPhi=COS(Phi) : C2=CosPhi*CosPhi : TanPhi=TAN(Phi) : T2=TanPhi*TanPhi
   Lambda0=INT((LonWGS+180)/6)+1 : REM Fuseau UTM
   Lambda0=6*Lambda0-183 : REM Méridien de Référence de la Projection
   REM ------------ Prise en compte particularites grille UTM 03/04/2017 --
   IF LatWGS>=56 AND LatWGS<64 AND LonWGS>=0 AND LonWGS<12 THEN
      REM Exception Norvege
      IF LonWGS>=3 THEN Lambda0=7.5 ELSE Lambda0=1.5
   ENDIF
   IF LatWGS>=72 AND LatWGS<84 AND LonWGS>=0 AND LonWGS<42 THEN
      REM Exception Svalbard
      Lambda0=4.5
      IF LonWGS>=9 THEN Lambda0=15
      IF LonWGS>=21 THEN Lambda0=27
      IF LonWGS>=33 THEN Lambda0=37.5
   ENDIF
   REM --------------------------------------------------------------------
   Lambda0=Lambda0*Deg2Rad : REM en Radians !
   A=(Lambda-Lambda0)*CosPhi
   A2=A*A : A3=A*A2 : A4=A*A3 : A5=A*A4 : A6=A*A5
   k0=0.9996
   k1=1-PrExc2/4-3*PrExc4/64-5*PrExc6/256
   k2=3*PrExc2/8+3*PrExc4/32+45*PrExc6/1024
   k3=15*PrExc4/256+45*PrExc6/1024
   k4=35*PrExc6/3072
   C=PrExc2/(1-PrExc2)*C2
   sPhi=k1*Phi-k2*SIN(2*Phi)+k3*SIN(4*Phi)-k4*SIN(6*Phi)
   vPhi=1/SQR(1-PrExc2*S2)
   tPhi=TanPhi*(A2/2+(5-T2+9*C+4*C*C)*A4/24+(61-58*T2+T2*T2)*A6/720)
   IF LatWGS<0 THEN Nz=10000000 ELSE Nz=0
   N=Nz+k0*aWGS*(sPhi+vPhi*tPhi)
   WGS_UTMNorthing=INT(N*10+0.5)/10
END FUNCTION

FUNCTION UTM_LatWGS(UtmX AS DOUBLE, UtmY AS DOUBLE, UtmZone AS STRING) AS DOUBLE
   ' Calcul de la Latitude géographique WGS84 en degrés décimaux à partir des coordonnées UTM
   ' d'après Algorithme de Steve Dutch - University of GreenBay, Wisconsin
   ' Longitudes Positives vers l'Est, Négatives vers l'Ouest
   ' Latitudes Positives vers le Nord, Négatives vers le Sud
   '
   DIM LatD, East AS DOUBLE
   DIM aWGS, bWGS, eWGS, e2, e4, e6, e1sq, k0, arc, mu, e1 AS DOUBLE
   DIM ca, cb, cc, cd, phi1 AS DOUBLE
   DIM Sin1, q0, t0, n0, r0, dd0 AS DOUBLE
   DIM fact1, fact2, fact3, fact4 AS DOUBLE
   DIM Hemisphere AS STRING
   REM   ----------------------------------
   REM   Conversions Degrés <---> Radians
   DIM Rad2Deg, Deg2Rad AS DOUBLE
   Rad2Deg=180/PI(): Deg2Rad=PI()/180
   REM   ----------------------------------
   IF UCase(UtmZone)>"M" THEN Hemisphere="N" ELSE Hemisphere="S"
   REM   système WGS84
   REM aWGS = Demi Grand-Axe de l'ellipsoïde WGS84
   aWGS = 6378137
   REM bWGS = Demi Petit-Axe de l'ellipsoïde WGS84
   bWGS = 6356752.314
   REM eWGS = Première Excentricité de l'ellipsoïde WGS84
   eWGS = SQR(1 - ((bWGS / aWGS)*(bWGS / aWGS))):e2=eWGS*eWGS:e4=e2*e2:e6=e4*e2
   East = UtmX
   IF Hemisphere = "S" THEN LatD = 10000000 - UtmY ELSE LatD = UtmY
   e1sq = e2 / (1 - e2): k0 = 0.9996
   arc = LatD / k0
   mu = arc / (aWGS * (1 - e2 / 4 - 3 * e4 / 64 - 5 * e6 / 256))
   e1 = (1 - (1 - e2) ^ 0.5) / (1 + (1 - e2) ^ 0.5)
   ca = 3 * e1 / 2 - 27 * e1 ^ 3 / 32
   cb = 21 * e1 ^ 2 / 16 - 55 * e1 ^ 4 / 32
   cc = 151 * e1 ^ 3 / 96
   cd = 1097 * e1 ^ 4 / 512
   phi1 = mu + ca * SIN(2 * mu) + cb * SIN(4 * mu) + cc * SIN(6 * mu) + cd * SIN(8 * mu)
   q0 = e1sq * COS(phi1) ^ 2: t0 = TAN(phi1) ^ 2
   n0 = aWGS / ((1 - (eWGS * SIN(phi1)) ^ 2) ^ (0.5))
   r0 = aWGS * (1 - eWGS * eWGS) / (1 - (eWGS * SIN(phi1)) ^ 2) ^ (3 / 2)
   dd0 = (500000 - East) / (n0 * k0)
   fact1 = n0 * TAN(phi1) / r0: fact2 = dd0 * dd0 / 2
   fact3 = (5 + 3 * t0 + 10 * q0 - 4 * q0 * q0 - 9 * e1sq) * dd0 ^ 4 / 24
   fact4 = (61 + 90 * t0 + 298 * q0 + 45 * t0 * t0 - 252 * e1sq - 3 * q0 * q0) * dd0 ^ 6 / 720
   IF Hemisphere = "N" THEN
      UTM_LatWGS = (phi1 - fact1 * (fact2 + fact3 + fact4))*Rad2Deg
   ELSE
      UTM_LatWGS = (-(phi1 - fact1 * (fact2 + fact3 + fact4)))*Rad2Deg
   ENDIF
END FUNCTION

FUNCTION UTM_LonWGS(UtmX AS DOUBLE, UtmY AS DOUBLE, UtmFuseau AS INTEGER, UtmZone AS STRING) AS DOUBLE
   ' Calcul de la Longitude géographique WGS84 en degrés décimaux à partir des coordonnées UTM
   ' d'après Algorithme de Steve Dutch - University of GreenBay, Wisconsin
   ' Longitudes Positives vers l'Est, Négatives vers l'Ouest
   ' Latitudes Positives vers le Nord, Négatives vers le Sud
   '
   DIM LatD, East AS DOUBLE
   DIM MCFuseau AS DOUBLE
   DIM aWGS, bWGS, eWGS, e2, e4, e6, e1sq, k0, arc, mu, e1 AS DOUBLE
   DIM ca, cb, cc, cd, phi1 AS DOUBLE
   DIM Sin1, q0, t0, n0, r0, dd0 AS DOUBLE
   DIM fact1, fact2, fact3 AS DOUBLE
   DIM Hemisphere AS STRING
   REM   ----------------------------------
   REM   Conversions Degrés <---> Radians
   DIM Rad2Deg, Deg2Rad AS DOUBLE
   Rad2Deg=180/PI(): Deg2Rad=PI()/180
   REM   ----------------------------------
   IF UCase(UtmZone)>"M" THEN Hemisphere="N" ELSE Hemisphere="S"
   REM   système WGS84
   REM aWGS = Demi Grand-Axe de l'ellipsoïde WGS84
   aWGS = 6378137
   REM bWGS = Demi Petit-Axe de l'ellipsoïde WGS84
   bWGS = 6356752.314
   REM eWGS = Première Excentricité de l'ellipsoïde WGS84
   eWGS = SQR(1 - ((bWGS / aWGS)*(bWGS / aWGS))):e2=eWGS*eWGS:e4=e2*e2:e6=e4*e2
   East = UtmX
   IF Hemisphere = "S" THEN LatD = 10000000 - UtmY ELSE LatD = UtmY
   ' Méridien Central du Fuseau
   MCFuseau = 6 * UtmFuseau - 183
   
   REM ------------ Prise en compte particularites grille UTM 03/04/2017 --
      REM Exception Norvege
      IF UtmZone="V" AND UtmFuseau=31 THEN MCFuseau=1.5
      IF UtmZone="V" AND UtmFuseau=32 THEN MCFuseau=7.5
      REM Exception Svalbard
      IF UtmZone="X" AND UtmFuseau=31 THEN MCFuseau=4.5
      IF UtmZone="X" AND UtmFuseau=33 THEN MCFuseau=15
      IF UtmZone="X" AND UtmFuseau=35 THEN MCFuseau=27
      IF UtmZone="X" AND UtmFuseau=37 THEN MCFuseau=37.5
   REM --------------------------------------------------------------------

   e1sq = e2 / (1 - e2): k0 = 0.9996
   arc = LatD / k0
   mu = arc / (aWGS * (1 - e2 / 4 - 3 * e4 / 64 - 5 * e6 / 256))
   e1 = (1 - (1 - e2) ^ 0.5) / (1 + (1 - e2) ^ 0.5)
   ca = 3 * e1 / 2 - 27 * e1 ^ 3 / 32
   cb = 21 * e1 ^ 2 / 16 - 55 * e1 ^ 4 / 32
   cc = 151 * e1 ^ 3 / 96
   cd = 1097 * e1 ^ 4 / 512
   phi1 = mu + ca * SIN(2 * mu) + cb * SIN(4 * mu) + cc * SIN(6 * mu) + cd * SIN(8 * mu)
   q0 = e1sq * COS(phi1) ^ 2: t0 = TAN(phi1) ^ 2
   n0 = aWGS / ((1 - (eWGS * SIN(phi1)) ^ 2) ^ (0.5))
   r0 = aWGS * (1 - e2) / (1 - (eWGS * SIN(phi1)) ^ 2) ^ (3 / 2)
   dd0 = (500000 - East) / (n0 * k0)
   fact1 = dd0
   fact2 = (1 + 2 * t0 + q0) * dd0 ^ 3 / 6
   fact3 = (5 - 2 * q0 + 28 * t0 - 3 * q0 ^ 2 + 8 * e1sq + 24 * t0 ^ 2) * dd0 ^ 5 / 120
   UTM_LonWGS = ((MCFuseau * Deg2Rad) - (fact1 - fact2 + fact3) / COS(phi1))*Rad2Deg
END FUNCTION

FUNCTION DFCI_LatWGS(DFCI AS STRING) AS DOUBLE
       ' Calcul de la Latitude geographique WGS84 en degres decimaux à partir des coordonnees DFCI
       '
   DIM Carr100, Carr20, Carr2, Zon5 AS STRING
   DIM XLamb, YLamb, LatNTF, LonNTF AS DOUBLE
   DIM x AS STRING
   DIM a AS DOUBLE
   REM   ----------------------------------
   Carr100=UCase(LEFT(DFCI,2)): Carr20=UCase(MID(DFCI,3,2)) : Carr2=UCase(MID(DFCI,5,2)) : Zon5=UCase(MID(DFCI,7,2))
   YLamb=1500000 : XLamb=0
   IF Len(Carr100)=2 THEN
      x=left(Carr100,1) : a=InStr("ABCDEFGHKLMN",x)-1 : XLamb=XLamb+a*100000
      x=right(Carr100,1) : a=InStr("ABCDEFGHKLMN",x)-1 : YLamb=YLamb+a*100000
      IF Len(Carr20)=2 THEN
         x=left(Carr20,1) : a=Val(x): XLamb=XLamb+a*10000
         x=right(Carr20,1) : a=Val(x) : YLamb=YLamb+a*10000
         IF Len(Carr2)=2 THEN
            x=left(Carr2,1) : a=InStr("ABCDEFGHKLMN",x)-1 : XLamb=XLamb+a*2000
            x=right(Carr2,1) : a=Val(x) : YLamb=YLamb+a*2000
            IF Len(Zon5)=2 THEN
               x=right(Zon5,1) : a=Val(x)
               SELECT CASE a
                  CASE 1
                     XLamb=XLamb+500 : YLamb=YLamb+1500
                  CASE 2
                     XLamb=XLamb+1500 : YLamb=YLamb+1500
                  CASE 3
                     XLamb=XLamb+500 : YLamb=YLamb+500
                  CASE 4
                     XLamb=XLamb+500 : YLamb=YLamb+500
                  CASE ELSE
                     XLamb=XLamb+1000 : YLamb=YLamb+1000
               END SELECT
            ELSE
               XLamb=XLamb+1000 : YLamb=YLamb+1000
            ENDIF
         ELSE
            XLamb=XLamb+5000 : YLamb=YLamb+5000
         ENDIF
      ELSE
         XLamb=XLamb+50000 : YLamb=YLamb+50000
      ENDIF
   ENDIF
   LatNTF=LambLatNTF(XLamb,YLamb,0) : LonNTF=LambLonNTF(XLamb,YLamb,0)
   DFCI_LatWGS=NTFLatWGS(LatNTF,LonNTF)
END FUNCTION

FUNCTION DFCI_LonWGS(DFCI AS STRING) AS DOUBLE
       ' Calcul de la Longitude geographique WGS84 en degres decimaux à partir des coordonnees DFCI
       '
   DIM Carr100, Carr20, Carr2, Zon5 AS STRING
   DIM XLamb, YLamb, LatNTF, LonNTF AS DOUBLE
   DIM x AS STRING
   DIM a AS DOUBLE
   REM   ----------------------------------
   Carr100=UCase(LEFT(DFCI,2)): Carr20=UCase(MID(DFCI,3,2)) : Carr2=UCase(MID(DFCI,5,2)) : Zon5=UCase(MID(DFCI,7,2))
   YLamb=1500000 : XLamb=0
   IF Len(Carr100)=2 THEN
      x=left(Carr100,1) : a=InStr("ABCDEFGHKLMN",x)-1 : XLamb=XLamb+a*100000
      x=right(Carr100,1) : a=InStr("ABCDEFGHKLMN",x)-1 : YLamb=YLamb+a*100000
      IF Len(Carr20)=2 THEN
         x=left(Carr20,1) : a=Val(x): XLamb=XLamb+a*10000
         x=right(Carr20,1) : a=Val(x) : YLamb=YLamb+a*10000
         IF Len(Carr2)=2 THEN
            x=left(Carr2,1) : a=InStr("ABCDEFGHKLMN",x)-1 : XLamb=XLamb+a*2000
            x=right(Carr2,1) : a=Val(x) : YLamb=YLamb+a*2000
            IF Len(Zon5)=2 THEN
               x=right(Zon5,1) : a=Val(x)
               SELECT CASE a
                  CASE 1
                     XLamb=XLamb+500 : YLamb=YLamb+1500
                  CASE 2
                     XLamb=XLamb+1500 : YLamb=YLamb+1500
                  CASE 3
                     XLamb=XLamb+500 : YLamb=YLamb+500
                  CASE 4
                     XLamb=XLamb+500 : YLamb=YLamb+500
                  CASE ELSE
                     XLamb=XLamb+1000 : YLamb=YLamb+1000
               END SELECT
            ELSE
               XLamb=XLamb+1000 : YLamb=YLamb+1000
            ENDIF
         ELSE
            XLamb=XLamb+5000 : YLamb=YLamb+5000
         ENDIF
      ELSE
         XLamb=XLamb+50000 : YLamb=YLamb+50000
      ENDIF
   ENDIF
   LatNTF=LambLatNTF(XLamb,YLamb,0) : LonNTF=LambLonNTF(XLamb,YLamb,0)
   DFCI_LonWGS=NTFLonWGS(LatNTF,LonNTF)
END FUNCTION
   
FUNCTION WGS_DFCI(LatWGS AS DOUBLE, LonWGS AS DOUBLE) AS STRING
   ' Calcul des coordonnées Cartographiques DFCI à partir des coordonnées Géographiques WGS84
   '
   DIM XLamb, YLamb, LatNTF, LonNTF AS DOUBLE
   DIM x, res AS STRING
   DIM a AS DOUBLE
   REM   ----------------------------------
   LatNTF=WGSLatNTF(LatWGS,LonWGS) : LonNTF=WGSLonNTF(LatWGS,LonWGS)
   REM Lambert 2 étendu !
   REM 1ERE LETTRE
   XLamb=NTFXLamb(LatNTF,LonNtf,0)
   a=INT(XLamb/100000) : XLamb=XLamb-a*100000 : IF a >7 THEN a=a+2
   x=Chr(a+65) : res=x
   REM 2EME LETTRE
   YLamb=NTFYLamb(LatNTF,LonNtf,0)-1500000
   a=INT(YLamb/100000) : YLamb=YLamb-a*100000 : IF a >7 THEN a=a+2
   x=Chr(a+65) : res=res & x
   REM 3EME LETTRE (CHIFFRE)
   a=INT(XLamb/20000) : XLamb=XLamb-a*20000 : res=res & a*2
   REM 4EME LETTRE (CHIFFRE)
   a=INT(YLamb/20000) : YLamb=YLamb-a*20000 : res=res & a*2
   REM 5EME LETTRE
   a=INT(XLamb/2000) : XLamb=XLamb-a*2000 : IF a >7 THEN a=a+2
   x=Chr(a+65) : res=res & x
   REM 6EME LETTRE (CHIFFRE)
   a=INT(YLamb/2000) : YLamb=YLamb-a*2000 : res=res & a
   IF XLamb>500 AND XLamb<1501 AND YLamb>500 AND YLamb<1501 THEN
      res=res & ".5"
   ELSE
      IF XLamb<1000 THEN
         IF YLamb<1000 THEN res=res & ".4" ELSE res=res & ".1"
      ELSE
         IF YLamb<1000 THEN res=res & ".3" ELSE res=res & ".2"
      ENDIF
   ENDIF
   WGS_DFCI=res
END FUNCTION

FUNCTION GeoDeCode(GLat AS DOUBLE, GLon AS DOUBLE, OPTIONAL Serv AS INTEGER) AS STRING
   REM Géocodage inverse : fournit l'adresse postale à partir des coordonnées WGS84
   REM Le paramètre optionnel Serv permet de choisir entre Google(1) et OpenStreetMap(0 ou absent)
   DIM T As Date
   IF ISMISSING(Serv) THEN Serv=0
   Svc = CreateUnoService( "com.sun.star.sheet.FunctionAccess" ) 'Crée un service pour utiliser les fonctions Calc
   Y=CStr(GLat) : Virgule=InStr(Y,","): If Virgule>0 Then Mid( Y, Virgule, 1 ) =  "."
   X=CStr(GLon) : Virgule=InStr(X,","): If Virgule>0 Then Mid( X, Virgule, 1 ) =  "."
   IF Serv=0 THEN
      ReqGMap="http://nominatim.openstreetmap.org/reverse?format=xml&lat=" & Y & "&lon=" & X
      Balise="result"
   ELSE
      ReqGMap="https://maps.googleapis.com/maps/api/geocode/xml?latlng=" & Y & "," & X
      Balise="formatted_address"
   ENDIF
   '   ajoute une temporisation de 1 seconde pour empêcher que le serveur n'envoie un message de refus !
    T = Timer + 1: Do Until Timer > T: DoEvents: Loop
    '   (les serveurs n'acceptent pas de demandes répétées trop fréquentes provenant de la même IP)
    XML_String = svc.callFunction("WEBSERVICE",Array(ReqGMap))
   DataDeb=instr(XML_String,"<" & Balise) : DataFin=instr(XML_String,"</" & Balise)
   XML_String = Mid(XML_String,DataDeb,DataFin-DataDeb)
   DataDeb=instr(XML_String,">") : XML_String = Mid(XML_String,DataDeb+1,65535)
   GeoDeCode=XML_String
END FUNCTION

FUNCTION UTM_MGRS(UtmX AS DOUBLE, UtmY AS DOUBLE, UtmFuseau AS INTEGER, UtmZone AS STRING, OPTIONAL Prec AS INTEGER, OPTIONAL CarSep AS STRING) AS STRING
   REM Transformation de coordonnées UTM au format militaire MGRS
   REM Le parametre Prec regit la precision souhaitee (le nombre de chiffres : 1=10km 2=1km 3=100m 4=10m 5=1m) 5 par defaut
   REM Le parametre CarSep correspond au separateur des groupes dans le resultat, <aucun> par defaut
   DIM Sep, res AS STRING
   DIM L1, L2, Offset AS LONG
   DIM X, Y, Fact AS DOUBLE
   IF ISMISSING(Prec) THEN
      Prec=5
   ELSE
      IF Prec>5 THEN Prec=5
      IF Prec<1 THEN Prec=1
   ENDIF
   Fact=0.5*10^(5-Prec)
   IF ISMISSING(CarSep) THEN Sep=" " ELSE Sep=LEFT(CarSep,1)
   res=FORMAT(UtmFuseau,"00") & Sep & UtmZone & Sep
   L1=((UtmFuseau-1) MOD 3)*8+INT(UtmX/100000)
   IF UtmFuseau MOD 2 = 0 THEN Offset=5 ELSE Offset=0
   L2=((Offset+INT(UtmY/100000)) mod 20)+1
   res=res & Mid("ABCDEFGHJKLMNPQRSTUVWXYZ",L1,1) & Mid("ABCDEFGHJKLMNPQRSTUV",L2,1) & Sep
   X=UtmX-INT(UtmX/100000)*100000 : X=INT(X+Fact)
   Y=UtmY-INT(UtmY/100000)*100000 : Y=INT(Y+Fact)
   res = res & LEFT(FORMAT(X,"00000"),Prec) & Sep & LEFT(FORMAT(Y,"00000"),Prec)
   UTM_MGRS=res
END FUNCTION

FUNCTION MGRS_FusUTM(Mgrs AS STRING) AS STRING
   DIM l,i AS INTEGER
   DIM c, VarIn AS STRING
   VarIn="" : l=LEN(Mgrs)
   FOR i=1 TO l
      c=MID(Mgrs,i,1)
      IF c>="A" AND c<="Z" THEN VarIn=VarIn & c
      IF c>="0" AND c<="9" THEN VarIn=VarIn & c
   NEXT i   
   MGRS_FusUTM=LEFT(VarIn,2)
END FUNCTION

FUNCTION MGRS_ZonUTM(Mgrs AS STRING) AS STRING
   DIM l,i AS INTEGER
   DIM c, VarIn AS STRING
   VarIn="" : l=LEN(Mgrs)
   FOR i=1 TO l
      c=MID(Mgrs,i,1)
      IF c>="A" AND c<="Z" THEN VarIn=VarIn & c
      IF c>="0" AND c<="9" THEN VarIn=VarIn & c
   NEXT i   
   MGRS_ZonUTM=MID(VarIn,3,1)
END FUNCTION

FUNCTION MGRS_UTMEasting(Mgrs AS STRING) AS DOUBLE
   DIM l,i AS INTEGER
   DIM c, VarIn, L1, XY AS STRING
   DIM X AS DOUBLE
   VarIn="" : l=LEN(Mgrs)
   FOR i=1 TO l
      c=MID(Mgrs,i,1)
      IF c>="A" AND c<="Z" THEN VarIn=VarIn & c
      IF c>="0" AND c<="9" THEN VarIn=VarIn & c
   NEXT i
   L1=MID(VarIn,4,1) : XY=MID(VarIn,6) : l=LEN(XY)/2
   X=VAL(LEFT(XY,l))
   OffX=Instr("ABCDEFGHJKLMNPQRSTUVWXYZ",L1)-1
   OffX=(OffX MOD 8)+1
   OffX=OffX*100000
   MGRS_UTMEasting=OffX+X
END FUNCTION

FUNCTION MGRS_UTMNorthing(Mgrs AS STRING) AS DOUBLE
   DIM l,i,j, RUtm AS INTEGER
   DIM c, VarIn, L2,XY, ZonUtm AS STRING
   DIM Y, FloorUtm AS DOUBLE
   VarIn="" : l=LEN(Mgrs)
   FOR i=1 TO l
      c=MID(Mgrs,i,1)
      IF c>="A" AND c<="Z" THEN VarIn=VarIn & c
      IF c>="0" AND c<="9" THEN VarIn=VarIn & c
   NEXT i
   L2=MID(VarIn,5,1) : ZonUtm=MID(VarIn,3,1) : XY=MID(VarIn,6) : l=LEN(XY)/2
   Y=VAL(RIGHT(XY,l))
   OffY=Instr("ABCDEFGHJKLMNPQRSTUV",L2)-1
   rem IF ZonUtm>"B" AND ZonUtm<"Y" THEN
         i=VAL(LEFT(VarIn,2)) : j=INT(i/2) :  IF i=2*j THEN OffY=OffY-5
   rem ENDIF
   OffY=OffY*100000 : OffY=OffY+Y
   IF ZonUtm>="N" THEN
      REM Hemisphere Nord
      RUtm=Instr("ABCDEFGHJKLMNPQRSTUVWXYZ",ZonUtm)-13 : IF RUtm>10 THEN RUtm=10
      FloorUtm=110500*8*RUtm
      WHILE OffY<FloorUtm
         OffY=OffY+2000000
      WEND
   ELSE
   REM Hemisphere Sud
      RUtm=13-Instr("ABCDEFGHJKLMNPQRSTUVWXYZ",ZonUtm)
      FloorUtm=110500*(90-(RUtm*8))
      WHILE OffY<FloorUtm
         OffY=OffY+2000000
      WEND
   ENDIF
   MGRS_UTMNorthing=OffY
END FUNCTION

Pièces jointes
Geo.ods
Fichier tableur illustrant l'utilisation des fonctions dont le code est fourni.
(37.58 Kio) Téléchargé 819 fois
Dernière édition par PK1157 le 03 Avr 2017 21:07, édité 9 fois.
Libre Office sur Windows 7 et 10 et Linux Xubuntu
Avatar de l’utilisateur
PK1157
NOOuvel adepte
NOOuvel adepte
 
Message(s) : 13
Inscrit le : 30 Jan 2011 22:26

Re: Conversion de coordonnées Géo ou Cartographiques

Messagepar lmerger » 30 Jan 2011 23:25

Bonsoir,
Je connais des gens a qui en effet cela pourrait être utile un jour.
Il faudrait les packager dans une extension dans l'immédiat je pense.
L.
Ps : tu peux sans doute le poster section projet ou extension aussi ?

 Ajout : j'oubliais : félicitations également pour ce travail que tu donnes à la communauté !! bien que je n'y connaisse pas grand chose (...à un delta près :wink: ). 
Dernière édition par lmerger le 31 Jan 2011 20:20, édité 1 fois.
Laurent

OpenOffice 3.3.0 & Windows XP
---
utilise [F1], {Xray,SDK} ou encore 'GOOgle'
lmerger
Membre OOrganisé
Membre OOrganisé
 
Message(s) : 85
Inscrit le : 16 Déc 2010 16:06
Localisation : Lyon, France

Re: [Calc]Conversion de coordonnées Géo ou Cartographiques

Messagepar Sébastien C » 31 Jan 2011 14:57

Bonjour à tous,

Non seulement cela peut intéresser quelqu’un, mais c’est simplement très utile dès que l’on est (comme moi) amené à toucher aux coordonnées géographiques en provenance de bases de données extérieures sans y connaitre grand chose. Un grand merci à vous donc pour ce partage. Ce sera évidemment aux modérateurs de vous dire dans quelle section de ce forum ce code trouverait le plus sa place. Mais sachant qu’une extension donne plus difficilement accès au code que sa simple publication, je trouverais pour ma part préférable de publier votre travail dans la rubrique « Suprême de code ». Cela permettrait aux programmeurs d’aller « piquer » juste la bonne fonction selon le besoin du moment.

À charge encore pour vous de rajouter peut-être un fichier d’exemple qui illustrerait de façon didactique votre travail pourtant déjà fort commenté.

Bien à vous et merci encore,
:-) :bravo: :super:
LibreOffice 3.5.3.2 sous GNU-Linux Mageia 2.
Avatar de l’utilisateur
Sébastien C
Membre hOOnoraire
Membre hOOnoraire
 
Message(s) : 157
Inscrit le : 29 Avr 2008 00:21
Localisation : Meymac (19250)

Re: [Calc]Conversion de coordonnées Géo ou Cartographiques

Messagepar PK1157 » 31 Jan 2011 16:36

J'ai en effet publié ce travail sous forme d'un code-source, copiable et modifiable à loisir, afin de permettre à qui le souhaite d'en utiliser tout ou partie en fonction de ses besoins.
Je retiens la suggestion d'un fichier d'exemple, j'y travaillerai la semaine prochaine en raison d'un emploi du temps chargé.
Merci du temps passé à lire mon travail.
Cordialement,
PK1157
Libre Office sur Windows 7 et 10 et Linux Xubuntu
Avatar de l’utilisateur
PK1157
NOOuvel adepte
NOOuvel adepte
 
Message(s) : 13
Inscrit le : 30 Jan 2011 22:26

Re: [Calc]Conversion de coordonnées Géo ou Cartographiques

Messagepar Churay » 01 Fév 2011 17:36

Bonsoir,

Puisque nous sommes en pleine localisation, ma petite contribution avec le calcul de distance entre deux coordonnées.
En ignorant les nuances de Rayon moyen (GRS80 ou Picard) :

Code : Tout sélectionner   AgrandirRéduire
Option Explicit

Sub Main
Dim DistM As Double, msg As String

   DistM = Distance("7:5:21:N", "5:21:12:E", "48:22:33:N", "15:31:46:O")
   
   IF DistM > -1 Then
      Msg = "Distance : " & DistM & " Mille"
      IF DistM > 1 Then Msg = Msg & "s nautiques" Else Msg = Msg & " nautique"
      Msg = Msg & CHR(10) & "■■■■■■■ " & (DistM*1.852) & " km"
      MsgBox Msg
   End if
End Sub

Sub Distance(LattDep As String, LongDep As String,_
         LattArr As String, LongArr As String) As Double
Dim LattDepRad As Double, LongDepRad As Double, LaDep(), LaArr()
Dim LattArrRad As Double, LongArrRad As Double, LoDep(), LoArr()
   LaDep = Split(LattDep , ":")
   IF uBound(LaDep) <> 3 OR (LaDep(3) <> "N" AND LaDep(3) <> "S") Then
      MsgBox CHR(10) & "Lattitude de départ non valide : " & LattDep & CHR(10) & " "
      Distance = -1
      Exit sub
   End if
   LoDep = Split(LongDep , ":")
   IF uBound(LoDep) <> 3 OR (LoDep(3) <> "E" AND LoDep(3) <> "O") Then
      MsgBox CHR(10) & "Longitude de départ non valide : " & LongDep & CHR(10) & " "
      Distance = -1
      Exit sub
   End if
   LaArr = Split(LattArr , ":")
   IF uBound(LaArr) <> 3 OR (LaArr(3) <> "N" AND LaArr(3) <> "S") Then
      MsgBox CHR(10) & "Lattitude de destination non valide : " & LattArr & CHR(10) & " "
      Distance = -1
      Exit sub
   End if
   LoArr = Split(LongArr , ":")
   IF uBound(LoArr) <> 3 OR (LoArr(3) <> "E" AND LoArr(3) <> "O") Then
      MsgBox CHR(10) & "Longitude de destination non valide : " & LoArr & CHR(10) & " "
      Distance = -1
      Exit sub
   End if
   
   LattDepRad   = CInt(LaDep(0)) + CInt(LaDep(1))/60 + CInt(LaDep(2))/3600
   LattDepRad  = LattDepRad * PI() / 180
   IF LaDep(3) ="S" Then LattDepRad = -LattDepRad
   
   LongDepRad  = CInt(LoDep(0)) + CInt(LoDep(1))/60 + CInt(LoDep(2))/3600
   LongDepRad  = LongDepRad * PI() / 180
   IF LoDep(3) ="O" Then LongDepRad = -LongDepRad

   LattArrRad  = CInt(LaArr(0)) + CInt(LaArr(1))/60 + CInt(LaArr(2))/3600
   LattArrRad  = LattArrRad * PI() / 180
   IF LaArr(3) ="S" Then LattArrRad = -LattArrRad
   
   LongArrRad   = CInt(LoArr(0)) + CInt(LoArr(1))/60 + CInt(LoArr(2))/3600
   LongArrRad  = LongArrRad * PI() / 180
   IF LoArr(3) ="O" Then LongArrRad = -LongArrRad

   Distance = 60 * ( ACOS( SIN(LattDepRad) * SIN(LattArrRad) +_
                     COS(LattDepRad) * COS(LattArrRad) * COS(LongDepRad-LongArrRad) ) * 180 / PI() )
End Sub

Sub Acos(x as Double) As Double
   Acos = 1.5707963 - 2 * ATN( x / (1 + sqr(1 - x^2) )
End Sub


 Ajout : Pour les maîtres de Calc :
C'est mieux avec Calc : Au moins, Acos est connu... pas besoin d'une approximation, fût-elle pas trop mauvaise
;) 
cOOordialement
---
AOO 4.0.1 W7-PRO & LO 5.1.6.2 Debian 7.8 & Ubuntu 16.04 LTS
---
F1 : ça aide...
XRay + SDK :super:
---
Quand le NOT CONFIRMED sera corrigé (OOo et LO) , je serai heureux...
Avatar de l’utilisateur
Churay
ManitOOu
ManitOOu
 
Message(s) : 2668
Inscrit le : 30 Avr 2009 05:54
Localisation : CATALUNYA

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar alainbluegrass » 21 Juil 2011 10:47

Bonjour,
je tiens à vous remercier vivement pour votre travail.
je calais (je suis à Boulogne à coté !) depuis 2 jours sur ce problème et il ne me manquait plus que cela pour intégrer des relevés de mon palm (avec cetus, que je recommande) dans mon gvSIG.
merci encore

Alain
libreoffice 3.3.0 sur windows xp sp3 et ubuntu 11.04
Avatar de l’utilisateur
alainbluegrass
Fraîchement OOthentifié
 
Message(s) : 1
Inscrit le : 21 Juil 2011 10:36

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar binbin » 18 Nov 2011 12:26

désolé de déterrer le fil, mais je tenais à remercier l'auteur de ce travail qui vient de me sortir d'une mouise pas possible. N'ayant pas de connaissance en SIG, j'avais un travail de dev à fournir, je n'ai eu qu'à traduire les fonctions en javascript et tout a fonctionné. Encore merci et bravo !!!
OpenOffice 3.2 sous Win 7
binbin
Fraîchement OOthentifié
 
Message(s) : 1
Inscrit le : 18 Nov 2011 12:23

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar PK1157 » 18 Nov 2011 13:31

Merci de votre message qui me va droit au coeur.
N'oubliez pas d'intégrer à votre code source un commentaire citant (remerciant) les travaux publiés par l'I.G.N. et Steve Dutch - University of GreenBay, Wisconsin dont je me très largement inspiré.
Cordialement,
PK1157
Libre Office sur Windows 7 et 10 et Linux Xubuntu
Avatar de l’utilisateur
PK1157
NOOuvel adepte
NOOuvel adepte
 
Message(s) : 13
Inscrit le : 30 Jan 2011 22:26

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar Bidouille » 18 Nov 2011 15:06

Bonjour,

PK1157 a écrit:N'oubliez pas d'intégrer à votre code source un commentaire

Vous devriez inscrire vous même ces quelques lignes directement dans le programme que vous avez soumis.

Apposer une licence protège également votre travail.

Cordialement
Avatar de l’utilisateur
Bidouille
RespOOnsable forum
RespOOnsable forum
 
Message(s) : 10035
Inscrit le : 08 Nov 2005 17:23
Localisation : Brest, France

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar PK1157 » 18 Nov 2011 23:39

"Charité bien ordonnée ..."
Merci du conseil judicieux.
J'avais indiqué un lien et une référence au site du Prof. Dutch dans le fichier d'illustration, mais il est vrai que la place de tels commentaires est dans le code lui-même !
Oubli réparé.
Cordialement,
PK1157
Libre Office sur Windows 7 et 10 et Linux Xubuntu
Avatar de l’utilisateur
PK1157
NOOuvel adepte
NOOuvel adepte
 
Message(s) : 13
Inscrit le : 30 Jan 2011 22:26

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar aeoc » 08 Juin 2014 08:40

Bonjour,
Merci pour ce code.
Mais il n'a sûrement pas été testé:
- oubli des **/
- confusion dans les noms de variables (majuscule/minuscule, important une fois le code transformé en javascript)
- parenthèses manquantes
Open Office 4.1.0 sous Windows 7 pro
aeoc
Fraîchement OOthentifié
 
Message(s) : 1
Inscrit le : 08 Juin 2014 08:34

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar Piaf » 08 Juin 2014 11:08

Bonjour
aeoc a écrit:Mais il n'a sûrement pas été testé:
Ce serait étonnant
Téléchargé 1089 fois

et il me semble avoir vu
*****BASIC*****
tout en haut du Module.
Pour la traduction en javascript :
binbin a écrit:je n'ai eu qu'à traduire les fonctions en javascript et tout a fonctionné. Encore merci et bravo !!!
Il t'appartient de faire une traduction correcte et éventuellement de la poster dans la section Macros et API avec la balise [JavaScript]
A+
Libre Office Version: 6.1.6 et Apache OpenOffice 4.1.6 Sur Xubuntu 18.04 AMD64
Piaf
GourOOu
GourOOu
 
Message(s) : 5622
Inscrit le : 25 Nov 2011 19:07
Localisation : Guyane

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar PK1157 » 16 Juin 2014 20:54

Bonsoir,
Je n'aurais pas mieux dit (écrit !).
J'avoue que Java (quelle allitération délétère aurait dit le vieux Serge ...) n'est pas mon fort, nobody's perfect.
Merci d'avoir distingué entre lecture, compréhension, traduction, copie.
Pour la peine, j'ai ajouté à la collection la conversion WGS84 - DFCI et inverse, qui intéressera sans doute les pompiers ou chasseurs qui utilisent cette façon (un peu bizarre à mon goût) de désigner un carré de terrain, mais je ne suis ni chasseur ni pompier, alors ...
Bonne soirée à tous ceux qui, comme moi, aiment à connaître où sont leur pieds alors qu'ils ont la tête dans les nuages.
PK1157
Libre Office sur Windows 7 et 10 et Linux Xubuntu
Avatar de l’utilisateur
PK1157
NOOuvel adepte
NOOuvel adepte
 
Message(s) : 13
Inscrit le : 30 Jan 2011 22:26

Géocodage Inverse

Messagepar PK1157 » 30 Mars 2015 20:13

Une dernière (macro) pour la route ? (la rue, le boulevard, l'avenue, l'impasse ...)
Pourquoi ne pas utiliser les services que nous fournit Google pour transformer un couple de coordonnées en adresse postale ?
Application typique : un gestionnaire de réseau de transport (d'électricité, d'eau, de voyageurs, de gaz ...) dispose des coordonnées géographiques de ses répartiteurs, vannes, abribus, etc., mais souhaite donner à ses agents de maintenance une liste "human-readable" (intelligible) des lieux où ils devront intervenir.
La fonction OOBasic est simplissime, elle se contente d'appeler le "WebService" approprié et d'en filtrer le résultat.
Données à fournir : la latitude et la longitude dans le système WGS84 ;
Résultat : une chaîne de caractères correspondant à l'adresse postale la plus proche.
Code : Tout sélectionner   AgrandirRéduire
FUNCTION GeoDeCode(GLat AS DOUBLE, GLon AS DOUBLE) AS STRING
   REM Géocodage inverse : fournit l'adresse postale à partir des coordonnées WGS84
   Dim T As Date
   Svc = CreateUnoService( "com.sun.star.sheet.FunctionAccess" ) 'Crée un service pour utiliser les fonctions Calc
   Y=CStr(GLat) : Virgule=InStr(Y,","): If Virgule>0 Then Mid( Y, Virgule, 1 ) =  "."
   X=CStr(GLon) : Virgule=InStr(X,","): If Virgule>0 Then Mid( X, Virgule, 1 ) =  "."
   ReqGMap="https://maps.googleapis.com/maps/api/geocode/xml?latlng=" & Y & "," & X
   '   ajoute une temporisation de 1 dixième de seconde pour empêcher que Google n'envoie un message de refus !
    T = Timer + 0.1: Do Until Timer > T: DoEvents: Loop
    '   (les serveurs de Google n'acceptent pas de demandes répétées trop fréquentes provenant de la même IP)
    XML_String = svc.callFunction("WEBSERVICE",Array(ReqGMap))
   DataDeb=instr(XML_String,"<formatted_address>") : DataFin=instr(XML_String,"</formatted_address>")
   DataDeb=DataDeb+19 :
   GeoDeCode=Mid(XML_String,DataDeb,DataFin-DataDeb)
END FUNCTION
Libre Office sur Windows 7 et 10 et Linux Xubuntu
Avatar de l’utilisateur
PK1157
NOOuvel adepte
NOOuvel adepte
 
Message(s) : 13
Inscrit le : 30 Jan 2011 22:26

Re: Géocodage Inverse

Messagepar Dude » 31 Mars 2015 14:29

Salut,

PK1157 a écrit:Pourquoi ne pas utiliser les services que nous fournit Google

Les services G**gle sont généralement gratuits mais ils sont aussi propriétaires.
Pourquoi ne pas migrer vers la carte libre OpenStreetMap ?
Avatar de l’utilisateur
Dude
Grand Maître de l'OOffice
Grand Maître de l'OOffice
 
Message(s) : 20739
Inscrit le : 03 Mars 2006 08:45
Localisation : 127.0.0.1

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar PK1157 » 01 Avr 2015 10:38

Bonjour,
La suggestion est tout à fait pertinente !
En fait, j'ignorais qu'OSM fournissait un service analogue. J'ai fouillé un peu et voici le résultat :
Code : Tout sélectionner   AgrandirRéduire
FUNCTION GeoDeCode(GLat AS DOUBLE, GLon AS DOUBLE, OPTIONAL Serv AS INTEGER) AS STRING
   REM Géocodage inverse : fournit l'adresse postale à partir des coordonnées WGS84
   REM Le paramètre optionnel Serv permet de choisir entre Google(1) et OpenStreetMap(0 ou absent)
   Dim T As Date
   IF ISMISSING(Serv) THEN Serv=0
   Svc = CreateUnoService( "com.sun.star.sheet.FunctionAccess" ) 'Crée un service pour utiliser les fonctions Calc
   Y=CStr(GLat) : Virgule=InStr(Y,","): If Virgule>0 Then Mid( Y, Virgule, 1 ) =  "."
   X=CStr(GLon) : Virgule=InStr(X,","): If Virgule>0 Then Mid( X, Virgule, 1 ) =  "."
   IF Serv=0 THEN
      ReqGMap="http://nominatim.openstreetmap.org/reverse?format=xml&lat=" & Y & "&lon=" & X
      Balise="result"
   ELSE
      ReqGMap="https://maps.googleapis.com/maps/api/geocode/xml?latlng=" & Y & "," & X
      Balise="formatted_address"
   ENDIF
   '   ajoute une temporisation de 1 seconde pour empêcher que le serveur n'envoie un message de refus !
    T = Timer + 1: Do Until Timer > T: DoEvents: Loop
    '   (les serveurs n'acceptent pas de demandes répétées trop fréquentes provenant de la même IP)
    XML_String = svc.callFunction("WEBSERVICE",Array(ReqGMap))
   DataDeb=instr(XML_String,"<" & Balise) : DataFin=instr(XML_String,"</" & Balise)
   XML_String = Mid(XML_String,DataDeb,DataFin-DataDeb)
   DataDeb=instr(XML_String,">") : XML_String = Mid(XML_String,DataDeb+1,65535)
   GeoDeCode=XML_String
END FUNCTION

Je profite de l'occasion pour insister sur la temporisation indispensable (sous peine de bannissement) pour limiter les appels trop fréquents aux serveurs qui offrent cette fonction.
Libre Office sur Windows 7 et 10 et Linux Xubuntu
Avatar de l’utilisateur
PK1157
NOOuvel adepte
NOOuvel adepte
 
Message(s) : 13
Inscrit le : 30 Jan 2011 22:26

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar bm92 » 20 Juil 2015 15:21

Bonjour,
Pour la macro, DoEvents est une instruction VBA, qui ne fait rien en OpenOffice Basic, puisqu'il est interruptible entre chaque instruction. Mais le problème est que la boucle réalise une tempo variable entre 0 et 1 seconde.
Code : Tout sélectionner   AgrandirRéduire
' Au lieu de :
Dim T As Date
T = Timer + 1: Do Until Timer > T: DoEvents: Loop

' codage plus simple, plus précis, plus clair :
Wait(1000) ' attente 1 seconde


Il me semble utile de préciser que la fonction Calc SERVICEWEB (nom interne : WEBSERVICE) est disponible seulement sur LibreOffice depuis la version 4.2. Elle n'est pas documentée dans l'aide F1 de LibreOffice.

Mais on peut faire l'équivalent sur Apache OpenOffice (ou LibreOffice) avec une fonction codée en Basic:
Code : Tout sélectionner   AgrandirRéduire
Function getWebService(request As String) As String
Dim sfa As Object, flux As Object, repDoc As Object
Dim repXml As String

sfa = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
repDoc = CreateUnoService("com.sun.star.io.TextInputStream")
repXml = ""
Wait(1000) ' pas plus de 2 requêtes par seconde !
On Error GoTo badRequest
flux = sfa.openFileRead(request)
repDoc.InputStream = flux
Do while not repDoc.isEOF
  repXml = repXml & " " & repDoc.readLine
Loop
flux.closeInput
repDoc.closeInput
finished:
getWebService = repXml
Exit Function

badRequest:
  Resume finished
End Function

Après avoir rajouté cette fonction, il suffit de remplacer:
Code : Tout sélectionner   AgrandirRéduire
Svc = CreateUnoService( "com.sun.star.sheet.FunctionAccess" )
Wait(1000) ' attente 1 seconde
XML_String = svc.callFunction("WEBSERVICE",Array(ReqGMap))

Par ceci:
Code : Tout sélectionner   AgrandirRéduire
XML_String = getWebService(ReqGMap)


 Ajout : 01/09/2015 : Ajout de la fonction getWebService() pour remplacer la fonction Calc de LibreOffice 
Dernière édition par bm92 le 01 Sep 2015 18:02, édité 2 fois.
Bernard

OpenOffice.org 1.1.5 fr / Apache OpenOffice 4.1.1 / LibreOffice 5.0.5.2 (X64)
MS-Windows 7 SP1 64bits Familial
bm92
ManitOOu
ManitOOu
 
Message(s) : 2562
Inscrit le : 26 Nov 2005 14:42

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar PK1157 » 26 Juil 2015 20:52

Je souscris !
C'est bien plus clair (et plus "propre").
Merci
Libre Office sur Windows 7 et 10 et Linux Xubuntu
Avatar de l’utilisateur
PK1157
NOOuvel adepte
NOOuvel adepte
 
Message(s) : 13
Inscrit le : 30 Jan 2011 22:26

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar Mazzhe » 01 Sep 2015 16:42

J'avais besoin d'une fonction du même genre, alors les moteurs de recherche m'ont amené dans cette conversation.
C'est en fait la fonction inverse dont j'avais besoin : trouver des coordonnées à partir d'une adresse. Cela me permettra, après d'importer cette liste d'adresse dans umap (http://umap.openstreetmap.fr) pour les localiser sur une carte personnalisée.

Comme je ne connais pas le langage de programmation des macros, je me suis inspiré de ce qui est proposé par PK1157, que je remercie ! La fonction peut cependant peut-être être améliorée…
J'aurais pu créer 2 fonctions, une pour la latitude et une pour la longitude, mais cela aurait nécessité 2 appels au serveur pour les mêmes données, alors j'ai préféré formater les 2 résultats dans une même chaîne de caractères, que l'on peut disséquer ensuite avec des fonctions classiques de LibreOffice.

Elle reçoit donc en paramètres les données postales, telles que définies sur la page de nominatim (http://wiki.openstreetmap.org/wiki/FR:Nominatim), et la sortie est une chaine de caractères de la forme
latitude : longitude
Si l'adresse exacte n'est pas trouvée, une recherche est faite sur le nom de la commune uniquement. L'avertissement "(Commune)" est alors ajouté à la fin de la chaîne.


Code : Tout sélectionner   AgrandirRéduire
FUNCTION GeoCode(Street AS STRING, City AS STRING, County AS STRING, State AS STRING, Country AS STRING, Postalcode AS STRING) AS STRING
   REM Géocodage : fournit les coordonnées géodisques à partir de l'adresse postale
   REM crédit : Mazzhe, à partir de https://forum.openoffice.org/fr/forum/viewtopic.php?f=15&p=261513
   'Initialisation
   GeoCode=""
   Svc = CreateUnoService( "com.sun.star.sheet.FunctionAccess" ) 'Crée un service pour utiliser les fonctions Calc
   ReqGMap="http://nominatim.openstreetmap.org/search?format=xml&street=" & Street & "&city=" & City & "&county=" & County & "&state=" & State & "&country=" & Country & "&postalcode=" & Postalcode

   REM Interrogation du serveur nominatim
   '   ajoute une temporisation de 1 seconde pour empêcher que le serveur n'envoie un message de refus !
   '   (les serveurs n'acceptent pas de demandes répétées trop fréquentes provenant de la même IP)
   Wait(1000) ' attente 1 seconde
   XML_String = svc.callFunction("WEBSERVICE",Array(ReqGMap))
   
   REM Analyse de la réponse
   DataDebLat=instr(XML_String,"lat='")               : DataDebLon=instr(XML_String,"lon='")
   IF DataDebLat=0 THEN
       REM Adresse non trouvée, on réessaye sans l'adresse (rue)…
        ReqGMap="http://nominatim.openstreetmap.org/search?format=xml&city=" & City & "&county=" & County & "&state=" & State & "&country=" & Country & "&postalcode=" & Postalcode
         Wait(1000) ' attente 1 seconde
        XML_String = svc.callFunction("WEBSERVICE",Array(ReqGMap))
        DataDebLat=instr(XML_String,"lat='")               : DataDebLon=instr(XML_String,"lon='")
        REM …et on note l'approximation
         GeoCode=" (Commune)"
         DataDebLat=instr(XML_String,"lat='")               : DataDebLon=instr(XML_String,"lon='")
         REM Si la commune n'est pas trouvée, on abandonne là.
         IF DataDebLat=0 THEN
             GeoCode="Non trouvé"
         ENDIF
    ENDIF
    XML_String_lat = Mid(XML_String,DataDebLat+5,20)  : XML_String_lon = Mid(XML_String,DataDebLon+5,20)
    DataFinLat=instr(XML_String_lat,"'")-1            : DataFinLon=instr(XML_String_lon,"'")-1
    XML_String_lat = Mid(XML_String_lat,1,DataFinLat) : XML_String_lon = Mid(XML_String_lon,1,DataFinLon)
    GeoCode=XML_String_lat & " : " & XML_String_lon & GeoCode
END FUNCTION


N'hésitez pas à proposer des améliorations.
LibreOffice 5.0.1.2 / Debian GNU/Linux 7.9 (wheezy)
Mazzhe
NOOuvel adepte
NOOuvel adepte
 
Message(s) : 11
Inscrit le : 12 Sep 2009 18:29

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar bm92 » 01 Sep 2015 18:13

Bonjour,
Signature de PK1157 a écrit:Open Office 3.3 sur Windows 7 et 3.2 sur Ubuntu

Signature de Mazzhe a écrit:OpenOffice 3.0.1 / Ubuntu Linux 9.04

J'ai de bonnes raisons de penser que vous utilisez LibreOffice, et non Apache OpenOffice. Merci de mettre à jour vos signatures.

Pour les utilisateurs d'Apache OpenOffice, j'ai rajouté un équivalent de la fonction Calc, lire mon message plus haut.
Bernard

OpenOffice.org 1.1.5 fr / Apache OpenOffice 4.1.1 / LibreOffice 5.0.5.2 (X64)
MS-Windows 7 SP1 64bits Familial
bm92
ManitOOu
ManitOOu
 
Message(s) : 2562
Inscrit le : 26 Nov 2005 14:42

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar small.jl » 14 Avr 2016 16:34

Merci beaucoup pour ces fonctions de calcul de coordonnées. Cela m'a fait gagner beaucoup de temps et de matière grise pour mon propre logiciel de transformation de coordonnées et d'aide à la localisation des communes en Loire Atlantique. En particulier un grand merci pour les formules de transformation de coordonnées UTM en coordonnées géographiques WGS34 que je n'ai trouvé nul part ailleurs.
Bravo pour ce travail.
SMALL
OpenOffice version4.1.2 sur Windows7
small.jl
Fraîchement OOthentifié
 
Message(s) : 1
Inscrit le : 14 Avr 2016 16:28

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar Hubert Lambert » 18 Avr 2016 08:34

Bonjour,

Voici plusieurs jours que je tente de me débrouiller avec la documentation disponible sur la création d'add-ins pour Calc, et ce fil resurgit juste au moment où je cherchais un sujet d'exercices.
J'ai donc, comme test, traduit 4 des fonctions originales de PK1157 en python (DECDMS, DMSDEC, WGSLATNTF et WGSLONNTF) et les propose dans le fichier d'extension ci-joint.
Si les utilisateurs de ces macros le souhaitent, et bien sûr avec l'accord de PK1157 (s'il lit ce message), l'extension pourrait être étendue aux autres macros.

 Ajout : V2 (2.5.2016) : ajout des fonctions NTFLATWGS, NTFLONWGS, NTFXLAMB et NTFYLAMB. 

 Ajout : V3 (24.5.2016) : ajout des fonctions LAMBLATNTF, LAMBLONNTF, WGSXL93 et WGSYL93
(en cas de conflit avec la version précédente, désinstaller d'abord cette dernière). 

 Ajout : V4 (23.7.2016) : ajout des dernières fonctions. Toutes les fonctions sont donc désormais disponibles dans l'extension
(en cas de conflit avec la version précédente, la désinstaller d'abord puis redémarrer). 
Pièces jointes
GeoFunctions.oxt
Extension (v4) comprenant toutes les fonctions de PK1157
(12.3 Kio) Téléchargé 302 fois
Dernière édition par Hubert Lambert le 25 Juil 2016 17:53, édité 6 fois.
AOOo 4.1.2 sur Win7
AOOo 4.1.x sur Linux Mint
LibreOffice 5.x/6.x sur Linux Mint
--
| « Nos défauts devraient nous donner une qualité : l'indulgence pour les défauts des autres » (Rivarol)
Avatar de l’utilisateur
Hubert Lambert
SuppOOrter
SuppOOrter
 
Message(s) : 1103
Inscrit le : 06 Avr 2016 08:26

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar PK1157 » 02 Mai 2016 14:01

Bien entendu, AUCUNE RESTRICTION sur les transcriptions qui pourraient être réalisées à partir des macros que j'ai publiées ici !
C'est le principe de la publication libre, et j'ai moi-même retranscrit certaines parties de code issues d'autres environnements (en citant leur auteur ou ayant-droit).
Seule la qualité de la transcription compte !
(à ce sujet, une anecdote dont je ne sais si elle est exacte : les premiers exégèses de la foi chrétienne auraient mal traduit "charité" et "chasteté", ce qui condamne les prêtres depuis deux mille ans à porter la robe plutôt que d'aller voir dessous ...)
Lol, comme disent les djeun's !
PK1157
Libre Office sur Windows 7 et 10 et Linux Xubuntu
Avatar de l’utilisateur
PK1157
NOOuvel adepte
NOOuvel adepte
 
Message(s) : 13
Inscrit le : 30 Jan 2011 22:26

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar Riddick » 11 Août 2016 12:25

Bonjour,
Magnifique travail.
pensez vous un jour rajouter une conversion des coordonnées géographiques en MGRS ?

Merci d'avance
Apache Open Office 3.4.1 sous WIN7
Riddick
Fraîchement OOthentifié
 
Message(s) : 2
Inscrit le : 11 Août 2016 12:19

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar PK1157 » 19 Août 2016 08:46

Pourquoi pas ?
Vu le nombre de soldats qui cherchent les pokemons à nos carrefours, ces temps-ci, ça pourrait leur servir ...
Plus sérieusement, mes quelques souvenirs militaires me disent qu'il s'agit de convertir en bigrammes les entêtes UTM et que ça ne devrait pas être trop compliqué.
Je manque de temps en ce moment, mais après la rentrée, je m'y colle.
Merci beaucoup pour vos félicitations.
PK1157
Libre Office sur Windows 7 et 10 et Linux Xubuntu
Avatar de l’utilisateur
PK1157
NOOuvel adepte
NOOuvel adepte
 
Message(s) : 13
Inscrit le : 30 Jan 2011 22:26

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar Riddick » 21 Août 2016 15:49

Merci Pk, c sympa
Apache Open Office 3.4.1 sous WIN7
Riddick
Fraîchement OOthentifié
 
Message(s) : 2
Inscrit le : 11 Août 2016 12:19

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar Papyzede » 13 Mars 2017 11:06

Bonjour à tous,

Je dois en VB / BASIC trouver comment faire ces transformations

LAMBERT 1 vers RGF93-CC50
RGF93-CC50 vers LAMBERT 1

RGF93-CC50 vers RGF93
RGF93 vers RGF93-CC50

LAMBERT 1 vers RGF93
RGF93 vers LAMBERT 1

à partir d'un couple de coordonnées X et Y

Pourriez vous me venir en aide ?

Merci
Open Office sous Windows XP
Papyzede
Fraîchement OOthentifié
 
Message(s) : 3
Inscrit le : 10 Mars 2017 11:34

Re: [Calc] Conversion de coordonnées Géo ou Cartographiques

Messagepar bolem » 15 Mars 2017 18:12

Juste un mot Merci
je cherchais à faire cela (lambert 93 en DD) sous excel, je vais finalement me convertir plus vite à open office ;-)
OpenOffice 6.0.4 sous Windows 7 pro SP1
bolem
Fraîchement OOthentifié
 
Message(s) : 7
Inscrit le : 15 Mars 2017 18:10


Retour vers Suprême de code

Qui est en ligne ?

Utilisateur(s) parcourant ce forum : Aucun utilisateur inscrit et 1 invité