[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.
Avatar de l’utilisateur
PK1157
NOOuvel adepte
NOOuvel adepte
Messages : 13
Inscription : 30 janv. 2011 22:26

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

Message par PK1157 »

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

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é 1948 fois
Dernière modification par PK1157 le 03 avr. 2017 22:07, modifié 9 fois.
Libre Office sur Windows 7 et 10 et Linux Xubuntu
lmerger
Membre OOrganisé
Membre OOrganisé
Messages : 85
Inscription : 16 déc. 2010 16:06
Localisation : Lyon, France

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

Message par lmerger »

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 modification par lmerger le 31 janv. 2011 20:20, modifié 1 fois.
Laurent

OpenOffice 3.3.0 & Windows XP
---
utilise [F1], {Xray,SDK} ou encore 'GOOgle'
Avatar de l’utilisateur
Sébastien C
Membre hOOnoraire
Membre hOOnoraire
Messages : 157
Inscription : 29 avr. 2008 01:21
Localisation : Meymac (19250)
Contact :

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

Message par Sébastien C »

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
PK1157
NOOuvel adepte
NOOuvel adepte
Messages : 13
Inscription : 30 janv. 2011 22:26

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

Message par PK1157 »

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
Churay
ManitOOu
ManitOOu
Messages : 2668
Inscription : 30 avr. 2009 06:54
Localisation : CATALUNYA
Contact :

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

Message par Churay »

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

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
alainbluegrass
Fraîchement OOthentifié
Messages : 1
Inscription : 21 juil. 2011 11:36

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

Message par alainbluegrass »

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
binbin
Fraîchement OOthentifié
Messages : 1
Inscription : 18 nov. 2011 12:23

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

Message par binbin »

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
Avatar de l’utilisateur
PK1157
NOOuvel adepte
NOOuvel adepte
Messages : 13
Inscription : 30 janv. 2011 22:26

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

Message par PK1157 »

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
Bidouille
RespOOnsable forum
RespOOnsable forum
Messages : 12196
Inscription : 08 nov. 2005 17:23
Localisation : Caen, France
Contact :

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

Message par Bidouille »

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
PK1157
NOOuvel adepte
NOOuvel adepte
Messages : 13
Inscription : 30 janv. 2011 22:26

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

Message par PK1157 »

"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
aeoc
Fraîchement OOthentifié
Messages : 1
Inscription : 08 juin 2014 09:34

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

Message par aeoc »

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
Piaf
GourOOu
GourOOu
Messages : 5622
Inscription : 25 nov. 2011 19:07
Localisation : Guyane

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

Message par Piaf »

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
Avatar de l’utilisateur
PK1157
NOOuvel adepte
NOOuvel adepte
Messages : 13
Inscription : 30 janv. 2011 22:26

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

Message par PK1157 »

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
Messages : 13
Inscription : 30 janv. 2011 22:26

Géocodage Inverse

Message par PK1157 »

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

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
Dude
IdOOle de la suite
IdOOle de la suite
Messages : 25142
Inscription : 03 mars 2006 08:45
Localisation : 127.0.0.1
Contact :

Re: Géocodage Inverse

Message par Dude »

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
PK1157
NOOuvel adepte
NOOuvel adepte
Messages : 13
Inscription : 30 janv. 2011 22:26

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

Message par PK1157 »

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

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
bm92
ManitOOu
ManitOOu
Messages : 2562
Inscription : 26 nov. 2005 14:42
Contact :

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

Message par bm92 »

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

' 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

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

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

XML_String = getWebService(ReqGMap)
 Ajout : 01/09/2015 : Ajout de la fonction getWebService() pour remplacer la fonction Calc de LibreOffice 
Dernière modification par bm92 le 01 sept. 2015 19:02, modifié 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
Avatar de l’utilisateur
PK1157
NOOuvel adepte
NOOuvel adepte
Messages : 13
Inscription : 30 janv. 2011 22:26

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

Message par PK1157 »

Je souscris !
C'est bien plus clair (et plus "propre").
Merci
Libre Office sur Windows 7 et 10 et Linux Xubuntu
Mazzhe
NOOuvel adepte
NOOuvel adepte
Messages : 11
Inscription : 12 sept. 2009 19:29

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

Message par Mazzhe »

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

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)
bm92
ManitOOu
ManitOOu
Messages : 2562
Inscription : 26 nov. 2005 14:42
Contact :

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

Message par bm92 »

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
small.jl
Fraîchement OOthentifié
Messages : 1
Inscription : 14 avr. 2016 17:28

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

Message par small.jl »

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
Avatar de l’utilisateur
Hubert Lambert
SuppOOrter
SuppOOrter
Messages : 1214
Inscription : 06 avr. 2016 09:26

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

Message par Hubert Lambert »

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é 790 fois
Dernière modification par Hubert Lambert le 25 juil. 2016 18:53, modifié 6 fois.
AOOo 4.1.7 sur Win10
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
PK1157
NOOuvel adepte
NOOuvel adepte
Messages : 13
Inscription : 30 janv. 2011 22:26

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

Message par PK1157 »

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
Riddick
Fraîchement OOthentifié
Messages : 2
Inscription : 11 août 2016 13:19

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

Message par Riddick »

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
Avatar de l’utilisateur
PK1157
NOOuvel adepte
NOOuvel adepte
Messages : 13
Inscription : 30 janv. 2011 22:26

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

Message par PK1157 »

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
Riddick
Fraîchement OOthentifié
Messages : 2
Inscription : 11 août 2016 13:19

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

Message par Riddick »

Merci Pk, c sympa
Apache Open Office 3.4.1 sous WIN7
Papyzede
Fraîchement OOthentifié
Messages : 3
Inscription : 10 mars 2017 11:34

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

Message par Papyzede »

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
bolem
Fraîchement OOthentifié
Messages : 7
Inscription : 15 mars 2017 18:10

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

Message par bolem »

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
Goetlas
Fraîchement OOthentifié
Messages : 1
Inscription : 21 nov. 2019 09:54

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

Message par Goetlas »

Bonjour,

Merci pour cette macro fabuleuse!!!

Mais est il possible de la transposer sur excel? et si oui comment (mon ordinateur au travail m'impose excel).

Cordialement,
Goetlas
Openoffice 5.1.6.2 sous windows 7
Avatar de l’utilisateur
Oukcha
RespOOnsable modération
RespOOnsable modération
Messages : 3929
Inscription : 06 oct. 2008 10:03

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

Message par Oukcha »

Bonjour,
Goetlas a écrit :est il possible de la transposer sur excel?
Merci de (re?)lire le bandeau rouge en haut de page :
Le bandeau rouge a écrit :Aucune question dans cette section !
De plus, votre question s'apparente au fonctionnement d'un logiciel propriétaire, vous devriez poster sur un forum dédié à celui-ci.

Sujet provisoirement verrouillé.
                                        
Pour tout savoir sur le fonctionnement de ce forum :arrow: À lire avant tout ! Image
Verrouillé