Publicité
+ Répondre à la discussion
Affichage des résultats 1 à 14 sur 14
  1. #1
    Membre Expert

    Inscrit en
    avril 2006
    Messages
    1 390
    Détails du profil
    Informations forums :
    Inscription : avril 2006
    Messages : 1 390
    Points : 1 961
    Points
    1 961

    Par défaut Conversion entre systèmes géodésiques

    bonjour,

    une classe qui permet de convertir des coordonnées planes ou géographiques entre différentes projections cartographiques et/ou systèmes géodésiques.

    Permet certaines transformations entre des coordonnées NTF Lambert, RGF Lambert93 (France) , WGS84, ED50, Lambert 72, BD72 (Belgique), ETRS89, Lambert08.

    Toutes les projections lambert de la France peuvent être converties en WGS84 (coordonnées géographiques utilisé par les GPS).

    Les conversions peuvent provoquer des écarts de quelques mètres.

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
    410
    411
    412
    413
    414
    415
    416
    417
    418
    419
    420
    421
    422
    423
    424
    425
    426
    427
    428
    429
    430
    431
    432
    433
    434
    435
    436
    437
    438
    439
    440
    441
    442
    443
    444
    445
    446
    447
    448
    449
    450
    451
    452
    453
    454
    455
    456
    457
    458
    459
    460
    461
    462
    463
    464
    465
    466
    467
    468
    469
    470
    471
    472
    473
    474
    475
    476
    477
     
    '---------------------------------------------------------------------------------------
    ' Projet     : SCG
    ' Module     : oSCG  [Module de classe]
    ' Version    : 1.0
    ' Création   : Le jeudi 26 juin 2008
    ' Auteur     : P.B. [Philben]
    ' Objet      : Conversion de coordonnées planes ou géographiques
    ' Référence  : <a href="http://www.IGN.fr(Institut" target="_blank">http://www.IGN.fr(Institut</a> géographique national - France)
    ' Utilisation: Voir la fonction TestConversions
    ' Remarque   : Seules certaines conversions sont vérifiées et sur un point seulement
    '              et donc cette classe ne doit être utilisée que dans un but ludo-éducatif
    '---------------------------------------------------------------------------------------
    Option Compare Database
    Option Explicit
    'A vrai pour tester des conversions et/ou les algorithmes (TestAlgos)
    #Const CCTEST = True
    #If CCTEST Then
    Private Enum eUnites
       gr
       rad
       dms
       m
       dd
    End Enum
    Private Type tResults
       dX As Double
       dY As Double
       sX As String
       sY As String
    End Type
    #End If
    'Enumération des projections et systèmes à convertir
    Public Enum eSCG
       BD72_Lambert72         'Projection Lambert 72 - Ellipsoïde Hayford 1924 - Belgique
       ETRS89_Lambert08       'Projection Lambert 2008 - Ellipsoïde GRS80 - Belgique
       ETRS89_Geo             'SG ETRS89 - Ellipsoïde GRS80 - Belgique
       ED50_Geo               'SG European Datum 1950 - Ellipsoïde Hayford 1909
       NTF_Lambert_I          'Projection Lambert I - Ellipsoïde NTF : Clarke 1880 - France
       NTF_Lambert_II         'Projection Lambert II - Ellipsoïde NTF : Clarke 1880 - France
       NTF_Lambert_III        'Projection Lambert III - Ellipsoïde NTF : Clarke 1880 - France
       NTF_Lambert_IV         'Projection Lambert IV - Ellipsoïde NTF : Clarke 1880 - France
       NTF_Lambert_II_Etendue 'Projection Lambert pour la France
       NTF_Paris_Geo          'SG NTF : Nouvelle triangulation de la France (méridien Paris)
       RGF93_Geo              'SG Réseau géodésique français - Ellipsoïde RGF : IAG GRS 80
       RGF93_Lambert_93       'Projection Lambert 93 - RGF : Réseau géodésique Français 1993
       WGS84_Geo              'SG World Geodetic System 1984
       BD72_Geo
    End Enum
    'Transformations possibles entre systèmes géodésiques
    Private Enum eTypeTrans
       NTFtoRGF93
       NTFtoED50
       NTFtoWGS84
       RGF93toNTF
       RGF93toED50
       RGF93toWGS84
       ED50toNTF
       ED50toRGF93
       ED50toWGS84
       WGS84toNTF
       WGS84toRGF93
       WGS84toED50
       ETRS89toBD72       'WGS84 <=> ETRS89 (European Terrestrial Reference System 1989) ?
       BD72toETRS89
    End Enum
    'colonnes du tableau des conversions autorisées
    'Abréviations :
    '  - PLA = Coordonnées planes d'une projection (X et Y en mètres) - Lambert seulement ici
    '  - GEO = Coordonnées géographiques d'un système géodésique (phi et lambda en radians)
    '  - CAR = Coordonnées cartésiennes d'un système géodésique
    'Schémas de conversion :
    '  1) Passage de coordonnées cartographiques planes d'une projection d'un système
    '     géodésique vers les coordonnées d'une projection d'un autre système géodésique
    '     - PLA_1 -> GEO_1 -> CAR_1 -> CAR_2 -> GEO_2 -> PLA_2
    '     - Entrée/Sortie (E/S) : X_1 et Y_1 -> X_2 et Y_2 (en mètres)
    '     - Exemple : Lambert_I (NTF) vers Lambert93 (RGF93)
    '  2) Passage de coordonnées cartographiques planes d'une projection d'un système
    '     géodésique vers les coordonnées géographiques d'un autre système géodésique
    '     - PLA_1 -> GEO_1 -> CAR_1 -> CAR_2 -> GEO_2
    '     - E/S :  X_1 et Y_1 (en mètres) -> phi_2 et lambda_2 (angles en radians avec phi = latitude et lambda = longitude)
    '     - Exemple : Lambert_I vers WGS84 (système utilisé par les GPS)
    '  3) Passage de coordonnées cartographiques planes d'une projection vers coordonnées
    '     cartographiques planes d'une autre projection d'un même système géodésique
    '     - PLA_1 -> GEO -> PLA_2
    '     - E/S : X_1 et Y_1 -> X_2 et Y_2 (en mètres)
    '     - Exemple : Lambert_I vers Lambert_II_étendue
    '  4) Passage de coordonnées géographiques d'un système géodésique vers
    '     les coordonnées cartographiques planes d'une projection d'un autre système géodésique
    '     - GEO_1 -> CAR_1 -> CAR_2 -> GEO_2 -> PLA_2
    '     - E/S : phi_1 et lambda_1 (en radian) -> X_2 et Y_2 (en mètres)
    '     - Exemple : WGS84 vers Lambert93
    '  5) Passage de coordonnées géographiques d'un système géodésique vers
    '     les coordonnées géographiques d'un autre système géodésique
    '     - GEO_1 -> CAR_1 -> CAR_2 -> GEO_2
    '     - E/S : phi_1 et lambda_1 -> phi_2 et lambda_2 (en radian)
    '     - Exemple : WGS84 vers ED50
    '
    'Les étapes possibles sont :
    '  1) PLA -> GEO     Fonction Alg04 - Passage d'une proj. Lambert vers coordonnées géographiques
    '  2) GEO1 -> GEO2   Fonction Alg09 - Passage de coordonnées géographiques à des coord. cartésiennes
    '                    Fonction Alg013 - Transformation d'un système géodésique à l'autre par coord. cartésiennes
    '                    Fonction Alg12 - Passage de coordonnées cartésiennes à des coord. géographiques
    '  3) GEO -> PLA     Fonction Alg04 - Passage de coord. géographiques en projection conique conforme de Lambert
    Private Enum eSchema
       eInitial = 0   'Système initial : Proj, Géo
       eFinal         'Système final: Géo, Proj
       bPLAtoGEO      'Etape 1
       eTypeTrans     'Type de tranformation pour bGEOtoGEO ou NULL si aucun
       bGEOtoPLA      'Etape 3
    End Enum
    'Paramètres de l'ellipsoïde du système initial et final
    Private Type tEllipsoide
       da As Double         '1/2 grand axe de l'ellipsoïde (mètre)
       db As Double         '1/2 petit axe de l'ellipsoïde (mètre) - Non utilisé directement
       df As Double         'Facteur d'aplatissement  - Non utilisé directement
       de As Double         'Première excentricité de l'ellipsoïde de référence
       dh As Double         'Hauteur au dessus de l'ellipsoïde (en mètre)
    End Type
    'Paramètres de la projection
    Private Type tProjection
       eType As eSCG
       dN As Double         'Exposant de la projection
       dc As Double         'Constante de la projection
       dXs As Double        'Coordonnées en projection du pôle
       dYs As Double
       dphi0 As Double      'Latitude du méridien d'origine (radian)
       dlambda0 As Double   'Longitude du méridien d'origine (ou central ?) (radian)
       dphi1 As Double      'Longitude du 1er parallèle automécoïque (radian)
       dphi2 As Double      'Longitude du 2ème parallèle automécoïque (radian)
       tEl As tEllipsoide   'Paramètres de l'ellipsoïde associée
    End Type
    'Paramètres de la transformation entre systèmes géo. cartésiens
    Private Type tTransformation
       dTx As Double
       dTy As Double
       dTz As Double
       dRx As Double
       dRy As Double
       dRz As Double
       dFacteurEchelle As Double
    End Type
     
    'Paramètres du Système de Conversion géodésique
    Private Type tSCG
       tInitial As tProjection
       tTrans As tTransformation
       tFinal As tProjection
    End Type
    Private Type t_XYZ
       dX As Double
       dY As Double
       dZ As Double
    End Type
    Private gdpi As Double
    Private gbInit As Boolean
    Private gsErreur As String
    Private gtXYZ As t_XYZ
    Private gavProcess As Variant
    Private gtSCG As tSCG
    Private Sub class_initialize()
       gdpi = 4 * Atn(1) 'Calcul de pi
    End Sub
    'Sélection du type de conversion
    Public Sub TypeConversion(ByVal eDe As eSCG, ByVal eVers As eSCG)
       Dim avConv() As Variant
       Dim i As Integer
     
       SetConversionsAutorises avConv
     
       If eDe <> eVers Then
          For i = 0 To UBound(avConv)
             If avConv(i)(eSchema.eInitial) = eDe And _
                avConv(i)(eSchema.eFinal) = eVers Then
                Exit For
             End If
          Next i
          'Conversion possible
          If i <= UBound(avConv) Then
             'Récupère le processus de conversion
             gavProcess = avConv(i)
     
             'Définir les systèmes
             SetProjection gtSCG.tInitial, eDe
             SetProjection gtSCG.tFinal, eVers
     
             'Définir l'éventuelle transformation
             If Not IsNull(gavProcess(eSchema.eTypeTrans)) Then
                SetTransformation gtSCG.tTrans, gavProcess(eSchema.eTypeTrans)
             End If
     
             gtXYZ.dX = 0
             gtXYZ.dY = 0
             gtXYZ.dZ = 0
             gsErreur = vbNullString
             gbInit = True
          Else
             gsErreur = "Conversion non définie..."
             gbInit = False
          End If
       Else
          gsErreur = "Pas de conversion nécessaire..."
          gbInit = False
       End If
    End Sub
    'Conversion à partir des mètres ou des radians selon le système de conversion
    Public Sub CalculSCG(ByVal dX As Double, dY As Double)
       Dim tXYZ As t_XYZ
       With tXYZ
          If gbInit Then
             'Si passage de coordonnées planes vers geographiques
             If gavProcess(eSchema.bPLAtoGEO) Then
                tXYZ = alg04(dX, dY, gtSCG.tInitial)
             Else
                'dx : Tenir compte du méridien d'origine
                .dX = dX + gtSCG.tInitial.dlambda0
                .dY = dY
             End If
             'Si passage de GEO1 vers GEO2
             If Not IsNull(gavProcess(eSchema.eTypeTrans)) Then
                tXYZ = alg09(.dX, .dY, gtSCG.tInitial.tEl) 'GEO1 -> CAR1
                tXYZ = alg13(tXYZ, gtSCG.tTrans)           'CAR1 -> CAR2
                tXYZ = alg12(tXYZ, gtSCG.tFinal.tEl)       'CAR2 -> GEO2
             End If
             If gavProcess(eSchema.bGEOtoPLA) Then
                tXYZ = alg03(.dX, .dY, gtSCG.tFinal)
             Else
                'dx : Tenir compte du méridien d'origine du système final
                .dX = .dX - gtSCG.tFinal.dlambda0
             End If
          Else
             gsErreur = "Système de conversion non initialisé..."
          End If
          gtXYZ.dX = .dX
          gtXYZ.dY = .dY
          gtXYZ.dZ = .dZ
       End With
    End Sub
    'Retourne le résultat : X  en mètre ou en radian (longitude)
    Public Property Get X() As Double
       X = gtXYZ.dX
    End Property
    'Retourne le résultat : Y  en mètre ou en radian (latitude)
    Public Property Get Y() As Double
       Y = gtXYZ.dY
    End Property
    Public Property Get pi()
       pi = gdpi
    End Property
    Public Property Get IsErreur()
       If Len(gsErreur) Then IsErreur = True
    End Property
    Public Property Get Erreur()
       Erreur = gsErreur
    End Property
    'alg01 - Appel par alg03 et alg54 - Calcul de la latitude isométrique à partir de la latitude
    Private Function alg01(ByVal dphi As Double, ByVal de As Double) As Double
       Dim dTmp As Double
       dTmp = de * Sin(dphi)
       alg01 = Log(Tan(gdpi / 4 + dphi / 2) * ((1 - dTmp) / (1 + dTmp)) ^ (de / 2))
    End Function
    'alg02 - Appel par algo04 - Calcul la latitude à partir de la latitude isométrique
    Private Function alg02(ByVal dphiIso As Double, ByVal de As Double, _
                           Optional ByVal depsilon As Double = 0.0000000001) As Double
       Dim dCurphi As Double, dLastphi As Double
       dCurphi = 2 * Atn(Exp(dphiIso)) - gdpi / 2
       Do
          dLastphi = dCurphi
          dCurphi = 2 * Atn(((1 + de * Sin(dLastphi)) / (1 - de * Sin(dLastphi))) ^ (de / 2) * Exp(dphiIso)) - gdpi / 2
       Loop Until Abs(dCurphi - dLastphi) < depsilon
       alg02 = dCurphi
    End Function
    'alg03 - Transformation de coordonnées géographiques en projection conique conforme de Lambert
    'Utilise la variable globale gtSCG pour les constantes de la projection finale
    Private Function alg03(ByVal dlambda As Double, ByVal dphi As Double, _
                           ByRef tProj As tProjection) As t_XYZ
       Dim dphiIso As Double, dTmp1 As Double, dtheta As Double
       With tProj
          dphiIso = alg01(dphi, .tEl.de)
          dTmp1 = .dc * Exp(-.dN * dphiIso)
          dtheta = .dN * (dlambda - .dlambda0)
          alg03.dX = .dXs + dTmp1 * Sin(dtheta)
          alg03.dY = .dYs - dTmp1 * Cos(dtheta)
       End With
    End Function
    'alg04 - Passage d'une projection Lambert vers des coordonnées géographiques
    'Utilise la variable globale gtSCG pour les constantes de la projection initiale
    Private Function alg04(ByVal dX As Double, ByVal dY As Double, _
                           ByRef tProj As tProjection, _
                           Optional ByVal depsilon As Double = 0.0000000001) As t_XYZ
       Dim dR As Double, dgamma As Double, dphiIso As Double
       With tProj
          dR = Sqr((dX - .dXs) ^ 2 + (dY - .dYs) ^ 2)
          dgamma = Atn((dX - .dXs) / (.dYs - dY))
          dphiIso = -1 / .dN * Log(Abs(dR / .dc))
          alg04.dX = .dlambda0 + dgamma / .dN
          alg04.dY = alg02(dphiIso, .tEl.de)
       End With
    End Function
    'alg21 - Appel par algo09 et alg54
    Private Function alg21(ByVal dphi As Double, ByVal da As Double, ByVal de As Double) As Double
       alg21 = da / Sqr(1 - de ^ 2 * Sin(dphi) ^ 2)
    End Function
    'alg09 - Passage de coordonnées géographiques à cartésiennes
    'Utilise la variable globale gtSCG pour l'ellipsoïde initiale
    Private Function alg09(ByVal dlambda As Double, ByVal dphi As Double, _
                           ByRef tEl As tEllipsoide) As t_XYZ
       Dim dN As Double
       dlambda = dlambda
       With tEl
          dN = alg21(dphi, .da, .de)
          alg09.dX = (dN + .dh) * Cos(dphi) * Cos(dlambda)
          alg09.dY = (dN + .dh) * Cos(dphi) * Sin(dlambda)
          alg09.dZ = (dN * (1 - .de ^ 2) + .dh) * Sin(dphi)
       End With
    End Function
    'alg12 - Passage de coordonnées cartésiennes à géographiques
    'Utilise la variable globale gtSCG pour l'ellipsoïde finale
    Private Function alg12(ByRef tXYZ As t_XYZ, _
                           ByRef tEl As tEllipsoide, _
                           Optional ByVal depsilon As Double = 0.0000000001) As t_XYZ
       Dim dCurphi As Double, dLastphi As Double, dTmp1 As Double, dTmp2 As Double
       Dim deCarre As Double, da As Double
       With tEl
          deCarre = .de ^ 2
          da = .da
       End With
       With tXYZ
          alg12.dX = Atn(.dY / .dX)
          dTmp1 = Sqr(.dX ^ 2 + .dY ^ 2)
          dTmp2 = da * deCarre
          dCurphi = Atn(.dZ / (dTmp1 * (1 - (dTmp2 / Sqr(.dX ^ 2 + .dY ^ 2 + .dZ ^ 2)))))
          Do
             dLastphi = dCurphi
             dCurphi = Atn(.dZ / (dTmp1 * (1 - (dTmp2 * Cos(dLastphi) / _
                      (dTmp1 * Sqr(1 - deCarre * Sin(dLastphi) ^ 2))))))
          Loop Until Abs(dCurphi - dLastphi) < depsilon
          alg12.dY = dCurphi
          alg12.dZ = dTmp1 / Cos(dCurphi) - (da / Sqr(1 - deCarre * Sin(dLastphi) ^ 2))
       End With
    End Function
    'alg13 - Passage d'un SG à l'autre par coordonnées cartésiennes
    'Utilise la variable globale gtSCG pour la transformation
    Private Function alg13(ByRef tXYZ As t_XYZ, ByRef tTrans As tTransformation) As t_XYZ
       With tTrans
          alg13.dX = .dTx + tXYZ.dX * (1 + .dFacteurEchelle) + tXYZ.dZ * .dRy - tXYZ.dY * .dRz
          alg13.dY = .dTy + tXYZ.dY * (1 + .dFacteurEchelle) + tXYZ.dX * .dRz - tXYZ.dZ * .dRx
          alg13.dZ = .dTz + tXYZ.dZ * (1 + .dFacteurEchelle) + tXYZ.dY * .dRx - tXYZ.dX * .dRy
       End With
    End Function
    'alg54 - Permet de calculer les constantes d'une projection conique conforme dans le cas sécant
    Private Sub alg54(ByRef tProj As tProjection, ByVal dX0 As Double, ByVal dY0 As Double)
       Dim dTmp1 As Double, dLatIso1 As Double
       With tProj
          dTmp1 = alg21(.dphi1, .tEl.da, .tEl.de) * Cos(.dphi1)
          dLatIso1 = alg01(.dphi1, .tEl.de)
          .dN = Log(alg21(.dphi2, .tEl.da, .tEl.de) * Cos(.dphi2) / dTmp1) / _
                (dLatIso1 - alg01(.dphi2, .tEl.de))
          .dc = (dTmp1 / .dN) * Exp(.dN * dLatIso1)
          .dXs = dX0
          If .dphi0 = gdpi / 2 Then
             .dYs = dY0 + .dc * Exp(.dN * alg01(.dphi0, .tEl.de))
          Else
             .dYs = dY0
          End If
       End With
    End Sub
    'Mise à zéro de la variable global gtSCG
    Private Sub ResetSCG()
       Dim tTmpSCG As tSCG
       gtSCG = tTmpSCG
    End Sub
    Private Sub SetProjection(ByRef tProj As tProjection, ByVal eType As eSCG)
       With tProj
          .eType = eType
          'Paramètres du Système géodésique
          '.tEl.dh = 0 par défaut (Hauteur au dessus de l'ellipsoïde car non utilisation de grille alti)
          Select Case eType
          Case eSCG.NTF_Lambert_I, _
               eSCG.NTF_Lambert_II, _
               eSCG.NTF_Lambert_III, _
               eSCG.NTF_Lambert_IV, _
               eSCG.NTF_Lambert_II_Etendue, _
               eSCG.NTF_Paris_Geo          'Ellipsoïde de Clarke 1880
             .dlambda0 = DMSToRadian(2, 20, 14.025)   'Paris = 2°20'14,025 E Greenwich
             .tEl.da = 6378249.2
             .tEl.db = 6356515#
             .tEl.de = CalculPremiereExcentricite(.tEl.da, .tEl.db)   '0.08248325676
          Case eSCG.RGF93_Lambert_93, _
               eSCG.RGF93_Geo              'Ellipsoïde IAG_GRS80
             .dlambda0 = DDToRadian(3)
             .tEl.da = 6378137
             .tEl.df = 1 / 298.257222101
             .tEl.db = CalculDemiPetitAxe(.tEl.da, .tEl.df)
             .tEl.de = CalculPremiereExcentricite(.tEl.da, .tEl.db)
          Case eSCG.WGS84_Geo              'Ellipsoïde WGS84
             .dlambda0 = 0
             .tEl.da = 6378137
             .tEl.df = 1 / 298.257223563
             .tEl.db = CalculDemiPetitAxe(.tEl.da, .tEl.df)
             .tEl.de = CalculPremiereExcentricite(.tEl.da, .tEl.db)   '0.08181919106
          Case eSCG.ED50_Geo, eSCG.BD72_Geo   'Ellipsoïde Hayford 1909 et International 1924 ?
             .dlambda0 = 0
             .tEl.da = 6378388
             .tEl.df = 1 / 297#
             .tEl.db = CalculDemiPetitAxe(.tEl.da, .tEl.df)
             .tEl.de = CalculPremiereExcentricite(.tEl.da, .tEl.db)   '0.08199188998
          End Select
     
          'Paramètres de la projection
          Select Case eType
          Case eSCG.NTF_Lambert_I   'Nord France
             .dphi0 = GradeToRadian(55#)
             .dphi1 = DMSToRadian(48, 35, 54.682)
             .dphi2 = DMSToRadian(50, 23, 45.282)
             .dN = 0.7604059656
             .dc = 11603796.98
             .dXs = 600000#
             .dYs = 5657616.674
          Case eSCG.NTF_Lambert_II   'Centre France
             .dphi0 = GradeToRadian(52#)
             .dphi1 = DMSToRadian(45, 53, 56.108)
             .dphi2 = DMSToRadian(47, 41, 45.652)
             .dN = 0.7289686274
             .dc = 11745793.39
             .dXs = 600000#
             .dYs = 6199695.768
          Case eSCG.NTF_Lambert_III   'Sud France
             .dphi0 = GradeToRadian(49#)
             .dphi1 = DMSToRadian(43, 11, 57.449)
             .dphi2 = DMSToRadian(44, 59, 45.938)
             .dN = 0.6959127966
             .dc = 11947992.52
             .dXs = 600000#
             .dYs = 6791905.085
          Case eSCG.NTF_Lambert_IV   'Corse
             .dphi0 = GradeToRadian(46.85)
             .dphi1 = DMSToRadian(41, 33, 37.396)
             .dphi2 = DMSToRadian(42, 46, 3.588)
             .dN = 0.6712679322
             .dc = 12136281.99
             .dXs = 234.358
             .dYs = 7239161.542
          Case eSCG.NTF_Lambert_II_Etendue   'France entière
             .dphi0 = GradeToRadian(52#)
             .dphi1 = DMSToRadian(45, 53, 56.108)
             .dphi2 = DMSToRadian(47, 41, 45.652)
             .dN = 0.7289686274
             .dc = 11745793.39
             .dXs = 600000#
             .dYs = 8199695.768
          Case eSCG.RGF93_Lambert_93          'France entière
             .dphi0 = DMSToRadian(46, 30)
             .dlambda0 = DDToRadian(3)
             .dphi1 = DDToRadian(44)
             .dphi2 = DDToRadian(49)
             .dN = 0.725607765
             .dc = 11754255.426
             .dXs = 700000#
             .dYs = 12655612.05
          Case eSCG.BD72_Lambert72            'Belgique
             .dphi0 = DDToRadian(90)
             .dlambda0 = DMSToRadian(4, 22, 2.952)
             .dphi1 = DMSToRadian(49, 50, 0.00204)
             .dphi2 = DMSToRadian(51, 10, 0.00204)
             'Calcul les constantes
             alg54 tProj, 150000.013, 5400088.438
          Case eSCG.ETRS89_Lambert08          'Belgique
             .dphi0 = DMSToRadian(50, 47, 52.134)
             .dlambda0 = DMSToRadian(4, 21, 33.177)
             .dphi1 = DMSToRadian(49, 50)
             .dphi2 = DMSToRadian(51, 10)
             'Calcul les constantes
             alg54 tProj, 649328#, 665262#
          End Select
       End With
    End Sub
    Dans le message suivant, la suite de la classe car ne tient pas dans ce message, code trop long)

    Philippe

  2. #2
    Membre Expert

    Inscrit en
    avril 2006
    Messages
    1 390
    Détails du profil
    Informations forums :
    Inscription : avril 2006
    Messages : 1 390
    Points : 1 961
    Points
    1 961

    Par défaut

    suite du code...

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
    410
    411
    412
    413
    414
    415
    416
    417
    418
    419
    420
    421
    422
    423
    424
    425
    426
    427
    428
    429
     
     
    'Paramètres de transformation d'un système à l'autre
    Private Sub SetTransformation(ByRef tTrans As tTransformation, ByVal eTrans As eTypeTrans)
       With tTrans
          'Selon convention de l'IERS : Coordinate Frame Rotation
          Select Case eTrans
          Case eTypeTrans.NTFtoRGF93, eTypeTrans.NTFtoWGS84, _
               eTypeTrans.RGF93toNTF, eTypeTrans.WGS84toNTF
             .dTx = -168
             .dTy = -60
             .dTz = 320
             If eTrans = eTypeTrans.RGF93toNTF Or eTrans = eTypeTrans.WGS84toNTF Then
                TransformationInverse tTrans
             End If
          Case eTypeTrans.NTFtoED50, eTypeTrans.ED50toNTF
             .dTx = -84
             .dTy = 37
             .dTz = 437
             If eTrans = eTypeTrans.ED50toNTF Then
                TransformationInverse tTrans
             End If
          Case eTypeTrans.ED50toWGS84, eTypeTrans.ED50toRGF93, _
               eTypeTrans.RGF93toED50, eTypeTrans.WGS84toED50
             .dTx = -84
             .dTy = -97
             .dTz = -117
             If eTrans = eTypeTrans.RGF93toED50 Or eTrans = eTypeTrans.WGS84toED50 Then
                TransformationInverse tTrans
             End If
          Case eTypeTrans.ETRS89toBD72, eTypeTrans.BD72toETRS89
             .dTx = 106.868628
             .dTy = -52.297783
             .dTz = 103.723893
             .dRx = 0.33657
             .dRy = -0.456955
             .dRz = 1.842183
             .dFacteurEchelle = 1.0000012747
             If eTrans = eTypeTrans.BD72toETRS89 Then
                TransformationInverse tTrans
             End If
          Case eTypeTrans.RGF93toWGS84, eTypeTrans.WGS84toRGF93
          'pas de transformation entre ces systèmes
          End Select
       End With
    End Sub
    'Détermine les paramètres de la transformation inverse
    Private Sub TransformationInverse(ByRef tTrans As tTransformation)
       With tTrans
          .dTx = -.dTx
          .dTy = -.dTy
          .dTz = -.dTz
          .dRx = -.dRx
          .dRy = -.dRy
          .dRz = -.dRz
          If .dFacteurEchelle <> 0 Then .dFacteurEchelle = 1 / .dFacteurEchelle
       End With
    End Sub
    Private Sub SetConversionsAutorises(ByRef avConv As Variant)
       Dim avC(0 To 56) As Variant
       avC(0) = VBA.Array(eSCG.NTF_Lambert_I, eSCG.NTF_Paris_Geo, True, Null, False)
       avC(1) = VBA.Array(eSCG.NTF_Lambert_I, eSCG.NTF_Lambert_II_Etendue, True, Null, True)
       avC(2) = VBA.Array(eSCG.NTF_Lambert_I, eSCG.RGF93_Geo, True, eTypeTrans.NTFtoRGF93, False)
       avC(3) = VBA.Array(eSCG.NTF_Lambert_I, eSCG.RGF93_Lambert_93, True, eTypeTrans.NTFtoRGF93, True)
       avC(4) = VBA.Array(eSCG.NTF_Lambert_I, eSCG.ED50_Geo, True, eTypeTrans.NTFtoED50, False)
       avC(5) = VBA.Array(eSCG.NTF_Lambert_I, eSCG.WGS84_Geo, True, eTypeTrans.NTFtoWGS84, False)
       avC(6) = VBA.Array(eSCG.NTF_Lambert_II, eSCG.NTF_Paris_Geo, True, Null, False)
       avC(7) = VBA.Array(eSCG.NTF_Lambert_II, eSCG.NTF_Lambert_II_Etendue, True, Null, True)
       avC(8) = VBA.Array(eSCG.NTF_Lambert_II, eSCG.RGF93_Geo, True, eTypeTrans.NTFtoRGF93, False)
       avC(9) = VBA.Array(eSCG.NTF_Lambert_II, eSCG.RGF93_Lambert_93, True, eTypeTrans.NTFtoRGF93, True)
       avC(10) = VBA.Array(eSCG.NTF_Lambert_II, eSCG.ED50_Geo, True, eTypeTrans.NTFtoED50, False)
       avC(11) = VBA.Array(eSCG.NTF_Lambert_II, eSCG.WGS84_Geo, True, eTypeTrans.NTFtoWGS84, False)
       avC(12) = VBA.Array(eSCG.NTF_Lambert_III, eSCG.NTF_Paris_Geo, True, Null, False)
       avC(13) = VBA.Array(eSCG.NTF_Lambert_III, eSCG.NTF_Lambert_II_Etendue, True, Null, True)
       avC(14) = VBA.Array(eSCG.NTF_Lambert_III, eSCG.RGF93_Geo, True, eTypeTrans.NTFtoRGF93, False)
       avC(15) = VBA.Array(eSCG.NTF_Lambert_III, eSCG.RGF93_Lambert_93, True, eTypeTrans.NTFtoRGF93, True)
       avC(16) = VBA.Array(eSCG.NTF_Lambert_III, eSCG.ED50_Geo, True, eTypeTrans.NTFtoED50, False)
       avC(17) = VBA.Array(eSCG.NTF_Lambert_III, eSCG.WGS84_Geo, True, eTypeTrans.NTFtoWGS84, False)
       avC(18) = VBA.Array(eSCG.NTF_Lambert_IV, eSCG.NTF_Paris_Geo, True, Null, False)
       avC(19) = VBA.Array(eSCG.NTF_Lambert_IV, eSCG.NTF_Lambert_II_Etendue, True, Null, True)
       avC(20) = VBA.Array(eSCG.NTF_Lambert_IV, eSCG.RGF93_Geo, True, eTypeTrans.NTFtoRGF93, False)
       avC(21) = VBA.Array(eSCG.NTF_Lambert_IV, eSCG.RGF93_Lambert_93, True, eTypeTrans.NTFtoRGF93, True)
       avC(22) = VBA.Array(eSCG.NTF_Lambert_IV, eSCG.ED50_Geo, True, eTypeTrans.NTFtoED50, False)
       avC(23) = VBA.Array(eSCG.NTF_Lambert_IV, eSCG.WGS84_Geo, True, eTypeTrans.NTFtoWGS84, False)
       avC(24) = VBA.Array(eSCG.NTF_Lambert_II_Etendue, eSCG.NTF_Paris_Geo, True, Null, False)
       avC(25) = VBA.Array(eSCG.NTF_Lambert_II_Etendue, eSCG.RGF93_Geo, True, eTypeTrans.NTFtoRGF93, False)
       avC(26) = VBA.Array(eSCG.NTF_Lambert_II_Etendue, eSCG.RGF93_Lambert_93, True, eTypeTrans.NTFtoRGF93, True)
       avC(27) = VBA.Array(eSCG.NTF_Lambert_II_Etendue, eSCG.ED50_Geo, True, eTypeTrans.NTFtoED50, False)
       avC(28) = VBA.Array(eSCG.NTF_Lambert_II_Etendue, eSCG.WGS84_Geo, True, eTypeTrans.NTFtoWGS84, False)
       avC(29) = VBA.Array(eSCG.NTF_Paris_Geo, eSCG.NTF_Lambert_II_Etendue, False, Null, True)
       avC(30) = VBA.Array(eSCG.NTF_Paris_Geo, eSCG.RGF93_Geo, False, eTypeTrans.NTFtoRGF93, False)
       avC(31) = VBA.Array(eSCG.NTF_Paris_Geo, eSCG.RGF93_Lambert_93, False, eTypeTrans.NTFtoRGF93, True)
       avC(32) = VBA.Array(eSCG.NTF_Paris_Geo, eSCG.ED50_Geo, False, eTypeTrans.NTFtoED50, False)
       avC(33) = VBA.Array(eSCG.NTF_Paris_Geo, eSCG.WGS84_Geo, False, eTypeTrans.NTFtoWGS84, False)
       avC(34) = VBA.Array(eSCG.RGF93_Geo, eSCG.NTF_Lambert_II_Etendue, False, eTypeTrans.RGF93toNTF, True)
       avC(35) = VBA.Array(eSCG.RGF93_Geo, eSCG.NTF_Paris_Geo, False, eTypeTrans.RGF93toNTF, False)
       avC(36) = VBA.Array(eSCG.RGF93_Geo, eSCG.RGF93_Lambert_93, False, Null, True)
       avC(37) = VBA.Array(eSCG.RGF93_Geo, eSCG.ED50_Geo, False, eTypeTrans.RGF93toED50, False)
       avC(38) = VBA.Array(eSCG.RGF93_Geo, eSCG.WGS84_Geo, False, eTypeTrans.RGF93toWGS84, False)
       avC(39) = VBA.Array(eSCG.RGF93_Lambert_93, eSCG.NTF_Paris_Geo, True, eTypeTrans.RGF93toNTF, False)
       avC(40) = VBA.Array(eSCG.RGF93_Lambert_93, eSCG.NTF_Lambert_II_Etendue, True, eTypeTrans.RGF93toNTF, True)
       avC(41) = VBA.Array(eSCG.RGF93_Lambert_93, eSCG.RGF93_Geo, True, Null, False)
       avC(42) = VBA.Array(eSCG.RGF93_Lambert_93, eSCG.ED50_Geo, True, eTypeTrans.RGF93toED50, False)
       avC(43) = VBA.Array(eSCG.RGF93_Lambert_93, eSCG.WGS84_Geo, True, eTypeTrans.RGF93toWGS84, False)
       avC(44) = VBA.Array(eSCG.ED50_Geo, eSCG.NTF_Paris_Geo, False, eTypeTrans.ED50toNTF, False)
       avC(45) = VBA.Array(eSCG.ED50_Geo, eSCG.NTF_Lambert_II_Etendue, False, eTypeTrans.ED50toNTF, True)
       avC(46) = VBA.Array(eSCG.ED50_Geo, eSCG.RGF93_Geo, False, eTypeTrans.ED50toRGF93, False)
       avC(47) = VBA.Array(eSCG.ED50_Geo, eSCG.RGF93_Lambert_93, False, eTypeTrans.ED50toRGF93, True)
       avC(48) = VBA.Array(eSCG.ED50_Geo, eSCG.WGS84_Geo, False, eTypeTrans.ED50toWGS84, False)
     
       avC(49) = VBA.Array(eSCG.WGS84_Geo, eSCG.NTF_Paris_Geo, False, True, True, eTypeTrans.WGS84toNTF)
       avC(50) = VBA.Array(eSCG.WGS84_Geo, eSCG.NTF_Lambert_II_Etendue, False, True, True, eTypeTrans.WGS84toNTF)
       avC(51) = VBA.Array(eSCG.WGS84_Geo, eSCG.RGF93_Geo, False, True, True, eTypeTrans.WGS84toRGF93)
       avC(52) = VBA.Array(eSCG.WGS84_Geo, eSCG.RGF93_Lambert_93, False, True, True, eTypeTrans.WGS84toRGF93)
       avC(53) = VBA.Array(eSCG.WGS84_Geo, eSCG.ED50_Geo, False, True, True, eTypeTrans.WGS84toED50)
     
       avC(54) = VBA.Array(eSCG.BD72_Lambert72, eSCG.ETRS89_Lambert08, True, eTypeTrans.BD72toETRS89, True)
       avC(55) = VBA.Array(eSCG.BD72_Lambert72, eSCG.ETRS89_Geo, True, eTypeTrans.BD72toETRS89, False)
     
       avC(56) = VBA.Array(eSCG.ETRS89_Lambert08, eSCG.BD72_Lambert72, True, eTypeTrans.ETRS89toBD72, True)
       avConv = avC
    End Sub
    Private Function CalculDemiPetitAxe(ByVal da As Double, ByVal df As Double) As Double
       CalculDemiPetitAxe = da * (1 - df)
    End Function
    Private Function CalculPremiereExcentricite(ByVal da As Double, ByVal db As Double) As Double
       Dim daCarre As Double
       daCarre = da ^ 2
       CalculPremiereExcentricite = Sqr((daCarre - db ^ 2) / daCarre)
    End Function
    Public Function GradeToRadian(ByVal dAngle As Double)
       GradeToRadian = gdpi * dAngle / 200
    End Function
    Public Function RadianToGrade(ByVal dAngle As Double)
       RadianToGrade = 200 * dAngle / gdpi
    End Function
    Public Function DDToRadian(ByVal dAngle As Double)
       DDToRadian = gdpi * dAngle / 180
    End Function
    Public Function RadianToDD(ByVal dAngle As Double)
       RadianToDD = 180 * dAngle / gdpi
    End Function
    Public Function DMSToDD(ByVal iDegre As Integer, _
                                  Optional ByVal byMin As Byte = 0, _
                                  Optional ByVal fSec As Single = 0) As Double
       DMSToDD = iDegre + byMin / 60 + fSec / 3600
    End Function
    Public Function AngleDMSToDD(ByVal dAngle As Double) As Double
       Dim iDegre As Integer, iMin As Integer
       Dim fSec As Single
       iDegre = Int(dAngle)
       iMin = Int((dAngle - iDegre) * 100)
       fSec = (dAngle - iDegre - iMin / 100) * 10000
       AngleDMSToDD = iDegre + iMin / 60 + fSec / 3600
    End Function
    Public Function DMSToRadian(ByVal iDegre As Integer, _
                                Optional ByVal byMin As Byte = 0, _
                                Optional ByVal fSec As Single = 0) As Double
       DMSToRadian = DDToRadian(DMSToDD(iDegre, byMin, fSec))
    End Function
    Public Function AngleDMSToRadian(ByVal dAngle As Double) As Double
       AngleDMSToRadian = DDToRadian(AngleDMSToDD(dAngle))
    End Function
    Public Function DDToAngleDMS(ByVal dAngle As Double) As Double
       Dim iDegre As Integer, iMin As Integer
       Dim fSec As Single
       iDegre = Int(dAngle)
       iMin = Int((dAngle - iDegre) * 60)
       fSec = (dAngle - iDegre - iMin / 60) * 3600
       DDToAngleDMS = Arrondi(iDegre + (iMin + fSec / 100) / 100, 7)
    End Function
    Public Function AngleDMSToString(ByVal dAngle As Double, _
                                ByVal bLatitude As Boolean) As String
       Dim iDegre As Integer, iMin As Integer
       Dim fSec As Single
       Dim s As String
       iDegre = Int(dAngle)
       iMin = Int((dAngle - iDegre) * 100)
       fSec = (dAngle - iDegre - iMin / 100) * 10000
       s = iDegre & "°" & format(iMin, "00'") & format(fSec, "00.0##''")
       If iDegre > 0 Then
          s = s & IIf(bLatitude, " N", " E")
       Else
          s = s & IIf(bLatitude, " S", " W")
       End If
       AngleDMSToString = s
    End Function
    Public Function RadianToStringDMS(ByVal dAngle As Double, _
                                      ByVal bLatitude As Boolean) As String
       RadianToStringDMS = AngleDMSToString(DDToAngleDMS(RadianToDD(dAngle)), bLatitude)
    End Function
    Public Function Arrondi(ByVal dVal As Double, Optional ByVal iDec As Integer = 0) As Double
        Arrondi = Int((dVal * (10 ^ iDec)) + 0.5) / (10 ^ iDec)
    End Function
    #If CCTEST Then
    Public Sub TestConversions()
       Debug.Print "--- Vérification de certaines conversions ---"
       Debug.Print vbTab & "+ NTF méridien de Paris -> ED50 Greenwich"
       Test NTF_Paris_Geo, ED50_Geo, 6, 54, "7°44'16,4''", "48°36'03,3''", gr, dms
       Debug.Print vbTab & "+ NTF méridien de Paris -> WGS84"
       Test NTF_Paris_Geo, WGS84_Geo, 6, 54, "7°44'12,2''", "48°35'59,9''", gr, dms
       Debug.Print vbTab & "+ NTF méridien de Paris -> NTF Lambert II étendue"
       Test NTF_Paris_Geo, NTF_Lambert_II_Etendue, 6, 54, "998137 m", "2413822 m", gr, m, 0
       Debug.Print vbTab & "+ NTF méridien de Paris -> RGF Lambert 93"
       Test NTF_Paris_Geo, RGF93_Lambert_93, 6, 54, "1049052 m", "6843777 m", gr, m, 0
    End Sub
    Public Sub TestAlgos()
       Dim tProj As tProjection
       Dim tTrans As tTransformation
       Dim tXYZ As t_XYZ
       Dim dVal As Double
       Dim av(0 To 2) As Variant
       Dim i As Integer
       Dim sTabs As String
       sTabs = vbTab & vbTab
     
       Debug.Print "--- Validation des algorithmes ---"
     
       'utilisé par alg01 et 02
       av(0) = VBA.Array(1.00552653648, 0.08199188998, 0.872664626)
       av(1) = VBA.Array(-0.3026169006, 0.08199188998, -0.29999999997)
       av(2) = VBA.Array(0.2, 0.08199188998, 0.19998903369)
     
       'alg01
       Debug.Print vbTab & "+ alg01 - Latitude isométrique à partir de la latitude"
       For i = 0 To UBound(av)
          Debug.Print sTabs & "Attendu -> phi(rad) : " & av(i)(0)
          Debug.Print sTabs & "Obtenu  -> phi(rad) : " & alg01(av(i)(2), av(i)(1))
          Debug.Print sTabs & "---"
       Next i
     
       'alg02
       Debug.Print vbTab & "+ alg02 - Latitude à partir de la latitude isométrique"
       For i = 0 To UBound(av)
          Debug.Print sTabs & "Attendu -> Lat iso : " & av(i)(2)
          Debug.Print sTabs & "Obtenu  -> Lat iso : " & alg02(av(i)(0), av(i)(1))
          Debug.Print sTabs & "---"
       Next i
       'alg03
       Debug.Print vbTab & "+ alg03 - Coordonnées géo vers Lambert"
       Debug.Print sTabs & "Attendu -> X : " & 1029705.0818 & " m _ Y : " & 272723.851 & " m"
       With tProj
          .tEl.de = 0.0824832568
          .dN = 0.760405966
          .dc = 11603796.9767
          .dlambda0 = 0.04079234433
          .dXs = 600000
          .dYs = 5657616.674
       End With
       tXYZ = alg03(0.145512099, 0.872664626, tProj)
       Debug.Print sTabs & "Obtenu  -> X : " & Arrondi(tXYZ.dX, 4) & " m _ Y : " & Arrondi(tXYZ.dY, 4) & " m"
       Debug.Print sTabs & "---"
       'alg04
       Debug.Print vbTab & "+ alg04 - Lambert vers coordonnées géo "
       Debug.Print sTabs & "Attendu -> lon : " & 0.14551209925 & " _ lat : " & 0.87266462567
       With tProj
          .tEl.de = 0.0824832568
          .dN = 0.760405966
          .dc = 11603796.9767
          .dlambda0 = 0.04079234433
          .dXs = 600000
          .dYs = 5657616.674
       End With
       tXYZ = alg04(1029705.083, 272723.849, tProj)
       Debug.Print sTabs & "Obtenu  -> Lon : " & Arrondi(tXYZ.dX, 11) & " _ Lat : " & Arrondi(tXYZ.dY, 11)
       Debug.Print sTabs & "---"
       'alg21
       Debug.Print vbTab & "+ alg21 - Calcul grande Normale"
       Debug.Print sTabs & "Attendu -> N : " & 6393174.9755 & " m"
       dVal = alg21(0.977384381, 6378388, 0.08199189)
       Debug.Print sTabs & "Obtenu  -> N : " & Arrondi(dVal, 4) & " m"
       Debug.Print sTabs & "---"
     
       'alg09
       Debug.Print vbTab & "+ alg09 - Coordonnées géo vers cartésiennes"
       Debug.Print sTabs & "Attendu -> X : " & 6376064.6955 & _
                   " m _ Y : " & 111294.623 & " m _ Z : " & 128984.725 & " m"
       With tProj.tEl
          .dh = 100
          .da = 6378249.2
          .de = 0.08248325679
       End With
       tXYZ = alg09(0.01745329248, 0.02036217457, tProj.tEl)
       Debug.Print sTabs & "Obtenu  -> X : " & Arrondi(tXYZ.dX, 4) & _
                   " m _ Y : " & Arrondi(tXYZ.dY, 4) & " m _ Z : " & Arrondi(tXYZ.dZ, 4) & " m"
       Debug.Print sTabs & "---"
       Debug.Print sTabs & "Attendu -> X : " & 6378232.2149 & _
                   " m _ Y : " & 18553.578 & " m _ Z : " & 0 & " m"
       With tProj.tEl
          .dh = 10
          .da = 6378249.2
          .de = 0.08248325679
       End With
       tXYZ = alg09(0.00290888212, 0, tProj.tEl)
       Debug.Print sTabs & "Obtenu  -> X : " & Arrondi(tXYZ.dX, 4) & _
                   " m _ Y : " & Arrondi(tXYZ.dY, 4) & " m _ Z : " & Arrondi(tXYZ.dZ, 4) & " m"
       Debug.Print sTabs & "---"
     
       'alg12
       Debug.Print vbTab & "+ alg12 - Coordonnées cartésiennes vers géo"
       Debug.Print sTabs & "Attendu -> Lon : " & 0.01745329248 & _
                   " _ Lat : " & 0.02036217457 & " _ h : " & 99.9995 & " m"
       With tProj.tEl
          .da = 6378249.2
          .de = 0.08248325679
       End With
       With tXYZ
          .dX = 6376064.695
          .dY = 111294.623
          .dZ = 128984.725
       End With
       tXYZ = alg12(tXYZ, tProj.tEl)
       Debug.Print sTabs & "Obtenu  -> Lon : " & Arrondi(tXYZ.dX, 11) & _
                   " _ Lat : " & Arrondi(tXYZ.dY, 11) & " _ h : " & Arrondi(tXYZ.dZ, 4) & " m"
       Debug.Print sTabs & "---"
       Debug.Print sTabs & "Attendu -> Lon : " & 0.00581776423 & _
                   " _ Lat : " & -0.03199770301 & " _ h : " & 2000.0001 & " m"
       With tXYZ
          .dX = 6376897.537
          .dY = 37099.705
          .dZ = -202730.907
       End With
       tXYZ = alg12(tXYZ, tProj.tEl)
       Debug.Print sTabs & "Obtenu  -> Lon : " & Arrondi(tXYZ.dX, 11) & _
                   " _ Lat : " & Arrondi(tXYZ.dY, 11) & " _ h : " & Arrondi(tXYZ.dZ, 4) & " m"
       Debug.Print sTabs & "---"
       'alg13
       Debug.Print vbTab & "+ alg13 - Coordonnées cartésiennes vers cartésiennes"
       Debug.Print sTabs & "Attendu -> Vx : " & 4154005.8099 & _
                   " m _ Vy : " & -80587.3284 & " m _ Vz : " & 4823289.5316 & " m"
       With tTrans
          .dTx = -69.4
          .dTy = 18
          .dTz = 452.2
          .dRx = 0
          .dRy = 0
          .dRz = 0.00000499358
          .dFacteurEchelle = -0.00000321
       End With
       With tXYZ
          .dX = 4154088.142
          .dY = -80626.331
          .dZ = 4822852.813
       End With
       tXYZ = alg13(tXYZ, tTrans)
       Debug.Print sTabs & "Obtenu  -> Vx : " & Arrondi(tXYZ.dX, 4) & _
                   " m _ Vy : " & Arrondi(tXYZ.dY, 4) & " m _ Vz : " & Arrondi(tXYZ.dZ, 4) & " m"
       Debug.Print sTabs & "---"
       Debug.Print "--- Fin ---"
    End Sub
    Private Sub Test(ByVal eDep As eSCG, ByVal eFin As eSCG, _
                     ByVal dXi As Double, dYi As Double, _
                     ByVal sXf As String, sYf As String, _
                     ByVal eUniteIn As eUnites, ByVal eUniteOut As eUnites, _
                     Optional byDecimal As Byte = 1)
       Dim tRes As tResults
       Dim sTabs As String
       sTabs = vbTab & vbTab
       Me.TypeConversion eDep, eFin
       If Me.IsErreur Then
          Debug.Print sTabs & "Erreur : " & Me.Erreur
       Else
          tRes = SetUnites(dXi, dYi, eUniteIn, True)
          With tRes
             Me.CalculSCG .dX, .dY
             Debug.Print sTabs & "Entrée  - Xi : " & dXi & .sX & " - Yi : " & dYi & .sY
             Debug.Print sTabs & "Attendu - Xf : " & sXf & " - Yf : " & sYf
             tRes = SetUnites(Me.X, Me.Y, eUniteOut, False, byDecimal)
             Debug.Print sTabs & "Obtenu  - Xc : " & .sX & " - Yc : " & .sY
          End With
       End If
    End Sub
    Private Function SetUnites(ByVal dX As Double, ByVal dY As Double, _
                               ByVal eUn As eUnites, ByVal bIn As Boolean, _
                               Optional ByVal iDec As Integer = 15) As tResults
       Dim tRes As tResults
       With tRes
          Select Case eUn
          Case eUnites.dms
             If bIn Then
                .dX = AngleDMSToRadian(dX)
                .dY = AngleDMSToRadian(dY)
                .sX = AngleDMSToString(dX, False)
                .sY = AngleDMSToString(dY, True)
             Else
                .sX = RadianToStringDMS(dX, False)
                .sY = RadianToStringDMS(dY, True)
             End If
          Case eUnites.gr
             If bIn Then
                .dX = GradeToRadian(dX)
                .dY = GradeToRadian(dY)
                .sX = " gr"
                .sY = .sX
             Else
                .sX = Arrondi(RadianToGrade(dX), iDec) & " gr"
                .sY = Arrondi(RadianToGrade(dY), iDec) & " gr"
             End If
          Case eUnites.m
             If bIn Then
                .dX = dX
                .dY = dY
                .sX = " m"
                .sY = .sX
             Else
                .sX = Arrondi(dX, iDec) & " m"
                .sY = Arrondi(dY, iDec) & " m"
             End If
          Case eUnites.rad
             If bIn Then
                .sX = " rad"
                .sY = .sX
             Else
                .sX = Arrondi(dX, iDec) & " m"
                .sY = Arrondi(dY, iDec) & " m"
             End If
          Case eUnites.dd
             If bIn Then
                .dX = DDToRadian(dX)
                .dY = DDToRadian(dY)
             Else
                .sX = Arrondi(RadianToDD(dX), iDec)
                .sY = Arrondi(RadianToDD(dY), iDec)
             End If
          End Select
       End With
       SetUnites = tRes
    End Function
    #End If
    Philippe

  3. #3
    Membre Expert

    Inscrit en
    avril 2006
    Messages
    1 390
    Détails du profil
    Informations forums :
    Inscription : avril 2006
    Messages : 1 390
    Points : 1 961
    Points
    1 961

    Par défaut Exemple d'application

    bonjour,

    * Version 1.01 de la classe car j'ai retiré (temporairement ?) les conversions pour les sytèmes utilisés en Belgique. En effet, après avoir résolu un bug de programmation sur un algo, les resultats obtenus ne sont toujours pas correctes.

    * Objectif de l'exemple
    Afficher sur une carte de France le contour des départements français à partir de coordonnées WGS84 (longitude et latitude).

    * Source des données
    l'IGN (http://ign.fr) propose de télécharger à l'adresse suivante
    http://www.ign.fr/rubrique.asp?rbr_id=2749&lng_id=FR un produit gratuit nommé GeoFLA qui contient plus de 49 000 coordonnées de contour des départements.
    Ces coordonnées sont en projection Lambert II étendue ou Lambert 93 au choix.

    La base de données jointe permet de convertir le fichier <GeoFLA Départements> (format Mif/Mid) de la projection Lambert 93 vers WGS84.
    Un autre formulaire permet ensuite d'afficher le contour d'un département sur une carte et les chefs-lieu.

    * Remarque
    Les tables de la base de données sont vides, il est donc nécessaire de télécharger le fichier <GEOFLA-dep-L93-MM.ZIP> puis de le décompresser dans le répertoire de la base pour l'importer via le formulaire d'importation Lambert 93.

    * Droits d'usage du fichier GeoFLA d'après l'IGN
    Tous les usages de ces fichiers sont autorisés, à l'exclusion de toute exploitation commerciale.
    la base exemple est téléchargeable ici (Access 2003):
    http://pbserv.free.fr/dev/SCG.zip

    Philippe

  4. #4
    Responsable Access
    Avatar de Arkham46
    Profil pro
    Inscrit en
    septembre 2003
    Messages
    4 777
    Détails du profil
    Informations personnelles :
    Localisation : France, Loiret (Centre)

    Informations forums :
    Inscription : septembre 2003
    Messages : 4 777
    Points : 9 176
    Points
    9 176

    Par défaut

    Bjr,

    Intéressant!

    Les contours se superposent bien avec le fond de carte.

    Beau travail.

  5. #5
    Membre Expert

    Inscrit en
    avril 2006
    Messages
    1 390
    Détails du profil
    Informations forums :
    Inscription : avril 2006
    Messages : 1 390
    Points : 1 961
    Points
    1 961

    Par défaut Autre exemple

    re bonjour,

    Tout d'abord, un grand merci à toi, Arkham46, pour ta super classe clGdiPlus sans laquelle ces petits programmes n'auraient pas existé et pour ton message d'encouragement !

    Comme GeoFla de l'IGN propose dans ses téléchargements 2 autres fichiers (lim_adm_france_dom.mid et lim_adm_france_dom.mif), j'ai décidé d'afficher ces limites administratives (cotières, frontières, régions, départements).

    Pour changer un peu, il faut importer la projection Lambert II étendu au format Mif/Mid ici .

    Suivre le même principe d'installation que le post précédent et les conditions d'utilisation de l'IGN sont les mêmes.

    Je me suis amusé aussi à estimer la longueur de chaque limite, mais il existe des gros écarts entre les valeurs officielles et celles trouvées (
    5500 km de côtes officiellement, je trouve 5200 km).
    Ceci s'explique, je pense, par une densité insuffisante de points et on a une discontinuité de calcul de longueur entre 2 segments.

    Le programme est téléchargeable ici :
    http://pbserv.free.fr/dev/SCG2.zip

    Philippe

  6. #6
    Membre Expert

    Inscrit en
    avril 2006
    Messages
    1 390
    Détails du profil
    Informations forums :
    Inscription : avril 2006
    Messages : 1 390
    Points : 1 961
    Points
    1 961

    Par défaut

    bonjour,


    Après une chasse aux bugs , cette version 1.03 semble stable :
    • Les conversions pour la Belgique entre Lambert 72 et Lambert 2008 sont opérationnelles a priori...
    • Des fonctions, des enums sont renommées pour être plus explicites;
    • Aide améliorée avec exemple de code;
    • Trois fonctions pour tester les algortihmes, les unités d'angle, les conversions et elles sont enrichies;
    • Ajout d'une fonction pour calculer la distance en km entre 2 positions Lon/Lat.
    • 64 conversions possibles entres coordonnées planes et géographiques
    Avec un peu de courage, je terminerai peut-être une IHM de conversion

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
    410
    411
    412
    413
    414
    415
    416
    417
    418
    419
    420
    421
    422
    423
    424
    425
    426
    427
    428
    429
    430
    431
    432
    433
    434
    435
    436
    437
    438
    439
    440
    441
    442
    443
    444
    445
    446
    447
    448
    449
    450
    451
    452
    453
    454
    455
    456
    457
    458
    459
    460
    461
    462
    463
    464
    465
    466
    467
    468
    469
    470
    471
    472
    473
    474
    475
    476
    477
    478
    479
    480
    481
    482
    483
    484
    485
    486
    487
    488
    489
    490
    491
    492
    493
    494
    495
    496
    497
    498
    499
    500
    501
    502
    503
    504
    505
    506
    507
    508
    509
    510
    511
    512
    513
    514
    515
    516
    517
    518
    519
    520
    521
    522
    523
    524
    525
    526
    527
    528
    529
    530
    531
    532
    533
    534
    535
    536
    537
    538
    539
    540
    541
    542
    543
    544
    545
    546
    547
    548
    549
    550
    551
    552
    553
    554
    555
     
    '---------------------------------------------------------------------------------------
    ' Projet     : SCG
    ' Module     : oSCG  [Module de classe]
    ' Version    : 1.03
    ' Création   : Le jeudi 26 juin 2008
    ' Auteur     : P.B. [Philben] - <a href="http://www.developpez.net" target="_blank">http://www.developpez.net</a> (forum : Access -> Contribuez)
    ' Objet      : Conversion de coordonnées planes ou géographiques de systèmes géodésiques
    ' Références : <a href="http://www.IGN.fr" target="_blank">http://www.IGN.fr</a> (Institut Géographique National - France)
    '              <a href="http://www.NGI.be" target="_blank">http://www.NGI.be</a> (Institut Géographique National - Belgique)
    ' Exemple    : - Conversion de Lambert II étendu (X et Y en mètres) vers WGS84 (Lon, Lat)
    '              Dim oConv as oSCG
    '              Set oConv = New oSCG
    '              oConv.TypeConversion NTF_Lambert_II_Etendu, WGS84_Geo
    '              If Not oConv.IsErreur Then
    '                 oConv.CalculSCG 647462, 2468321
    '                 Debug.Print "Longitude : " & oConv.RadianToDegreDec(oConv.X)
    '                 Debug.Print "Latitude  : " & oConv.RadianToDegreDec(oConv.Y)
    '              endif
    '              Set oConv = Nothing
    ' Tests      : - 3 fonctions permettent de vérifier les algorithmes, les conversions
    '                entres systèmes et les conversions entres les unités d'angle :
    '              Dim oConv as oSCG
    '              Set oConv = New oSCG
    '              oConv.TestAlgos
    '              oConv.TestAngles
    '              oConv.TestConversions
    '              Set oConv = Nothing
    '              -> Les Résultats sont affichés dans la fenêtre d'exécution de VBE (Debug.Print)
    ' Remarque   : Seules certaines conversions sont vérifiées et sur un point seulement
    '              => cette classe ne doit être utilisée que dans un but ludo-éducatif
    ' v1.01      : - Désactivation des conversions pour la belgique car bug persistant...
    '              - Ajout test alg54 (bug corrigé)
    '              - Ajout de tests de conversion
    ' v1.02      : - Correction d'un bug dans AngleDMSToString pour les coordonnées négatives
    ' v1.03      : - Réactivation des conversions pour la Belgique (bugs corrigés)
    '              - Modification de quelques noms de fonction, enum, etc.
    '              - Correction de quelques bugs mineurs
    '              - Ajout fonction DistanceKm qui calcule la distance en km entre 2 Lon/Lat
    '---------------------------------------------------------------------------------------
    Option Compare Database
    Option Explicit
    'A vrai pour tester des conversions et/ou les algorithmes (TestAlgos)
    #Const CCTEST = True
    #If CCTEST Then
    Private Enum eUnites
       gr
       rad
       dms
       m
       DD
    End Enum
    Private Type tResults
       dX As Double
       dY As Double
       sX As String
       sY As String
    End Type
    #End If
    'Enumération des projections et systèmes à convertir
    Public Enum eSCG
       BD72_Lambert72         'Projection Lambert 72 - Ellipsoïde Hayford 1924 - Belgique
       BD72_Geo
       ETRS89_Lambert08       'Projection Lambert 2008 - Ellipsoïde GRS80 - Belgique
       ETRS89_Geo             'SG ETRS89 - Ellipsoïde GRS80 - Belgique
       ED50_Geo               'SG European Datum 1950 - Ellipsoïde Hayford 1909
       NTF_Lambert_I          'Projection Lambert I - Ellipsoïde NTF : Clarke 1880 - France
       NTF_Lambert_II         'Projection Lambert II - Ellipsoïde NTF : Clarke 1880 - France
       NTF_Lambert_III        'Projection Lambert III - Ellipsoïde NTF : Clarke 1880 - France
       NTF_Lambert_IV         'Projection Lambert IV - Ellipsoïde NTF : Clarke 1880 - France
       NTF_Lambert_II_Etendu  'Projection Lambert pour la France
       NTF_Paris_Geo          'SG NTF : Nouvelle triangulation de la France (méridien Paris)
       RGF93_Geo              'SG Réseau géodésique français - Ellipsoïde RGF : IAG GRS 80
       RGF93_Lambert_93       'Projection Lambert 93 - RGF : Réseau géodésique Français 1993
       WGS84_Geo              'SG World Geodetic System 1984
    End Enum
    'Transformations définies dans le programme
    Private Enum eTypeTrans
       NTFtoRGF93
       NTFtoED50
       NTFtoWGS84
       RGF93toNTF
       RGF93toED50
       RGF93toWGS84
       ED50toNTF
       ED50toRGF93
       ED50toWGS84
       WGS84toNTF
       WGS84toRGF93
       WGS84toED50
       ETRS89toBD72
       BD72toETRS89
    End Enum
    'colonnes du tableau des conversions autorisées
    'Abréviations :
    '  - PLA = Coordonnées planes d'une projection (X et Y en mètre) - Lambert seulement ici
    '  - GEO = Coordonnées géographiques d'un système géodésique (lambda et phi en radian)
    '  - CAR = Coordonnées cartésiennes d'un système géodésique
    '  - lambda = longitude en radian
    '  - phi = latitude en radian
    'Schémas de conversion :
    '  1) Passage de coordonnées cartographiques planes d'une projection d'un système
    '     géodésique vers les coordonnées d'une projection d'un autre système géodésique
    '     - PLA_1 -> GEO_1 -> CAR_1 -> CAR_2 -> GEO_2 -> PLA_2
    '     - Entrée/Sortie (E/S) : X_1 et Y_1 -> X_2 et Y_2 (en mètres)
    '     - Exemple : Lambert_I (NTF) vers Lambert93 (RGF93)
    '  2) Passage de coordonnées cartographiques planes d'une projection d'un système
    '     géodésique vers les coordonnées géographiques d'un autre système géodésique
    '     - PLA_1 -> GEO_1 -> CAR_1 -> CAR_2 -> GEO_2
    '     - E/S :  X_1 et Y_1 (en mètres) -> lambda_2 et phi_2 (angles en radians avec phi = latitude et lambda = longitude)
    '     - Exemple : Lambert_I vers WGS84 (système utilisé par les GPS)
    '  3) Passage de coordonnées cartographiques planes d'une projection vers coordonnées
    '     cartographiques planes d'une autre projection d'un même système géodésique
    '     - PLA_1 -> GEO -> PLA_2
    '     - E/S : X_1 et Y_1 -> X_2 et Y_2 (en mètres)
    '     - Exemple : Lambert_I vers Lambert_II_étendu
    '  4) Passage de coordonnées géographiques d'un système géodésique vers
    '     les coordonnées cartographiques planes d'une projection d'un autre système géodésique
    '     - GEO_1 -> CAR_1 -> CAR_2 -> GEO_2 -> PLA_2
    '     - E/S : lambda_1 et phi_1 (en radian) -> X_2 et Y_2 (en mètres)
    '     - Exemple : WGS84 vers Lambert93
    '  5) Passage de coordonnées géographiques d'un système géodésique vers
    '     les coordonnées géographiques d'un autre système géodésique
    '     - GEO_1 -> CAR_1 -> CAR_2 -> GEO_2
    '     - E/S : lambda_1 et phi_1 -> lambda_2 et phi_2 (en radian)
    '     - Exemple : WGS84 vers ED50
    '
    'Les étapes possibles sont donc :
    '  1) PLA -> GEO     Fonction Alg04 - Passage d'une proj. Lambert vers coordonnées géographiques
    '  2) GEO1 -> GEO2   Fonction Alg09 - Passage de coordonnées géographiques à des coord. cartésiennes
    '                    Fonction Alg13 - Transformation d'un système géodésique à l'autre par coord. cartésiennes
    '                    Fonction Alg12 - Passage de coordonnées cartésiennes à des coord. géographiques
    '  3) GEO -> PLA     Fonction Alg03 - Passage de coord. géographiques en projection conique conforme de Lambert
    ' Remarque :
    ' - il est possible de définir d'autres transformations en utilisant un système
    '   comme pivot si on ne connait pas la transformation directe
    '   CAR_1 -> CAR_1bis (PIVOT) -> CAR_2
    Private Enum eSchema
       eInitial = 0   'Système initial : Proj, Géo
       eFinal         'Système final: Géo, Proj
       bPLAtoGEO      'Etape 1
       eTypeTrans     'Type de tranformation pour bGEOtoGEO ou NULL si aucun
       bGEOtoPLA      'Etape 3
    End Enum
    'Paramètres de l'ellipsoïde du système initial et final
    Private Type tEllipsoide
       da As Double         '1/2 grand axe de l'ellipsoïde (mètre)
       db As Double         '1/2 petit axe de l'ellipsoïde (mètre) - Non utilisé directement
       df As Double         'Facteur d'aplatissement  - Non utilisé directement
       de As Double         'Première excentricité de l'ellipsoïde de référence
       dh As Double         'Hauteur au dessus de l'ellipsoïde (en mètre)
    End Type
    'Paramètres de la projection
    Private Type tProjection
       eType As eSCG
       dN As Double         'Exposant de la projection
       dc As Double         'Constante de la projection
       dXs As Double        'Coordonnées en projection du pôle
       dYs As Double
       dphi0 As Double      'Latitude du méridien d'origine (radian)
       dlambda0 As Double   'Longitude du méridien d'origine (ou central ?) (radian)
       dphi1 As Double      'Longitude du 1er parallèle automécoïque (radian)
       dphi2 As Double      'Longitude du 2ème parallèle automécoïque (radian)
       tEl As tEllipsoide   'Paramètres de l'ellipsoïde associée
    End Type
    'Paramètres de la transformation entre systèmes géo. cartésiens
    Private Type tTransformation
       dTx As Double
       dTy As Double
       dTz As Double
       dRx As Double
       dRy As Double
       dRz As Double
       dFacteurEchelle As Double
    End Type
    'Paramètres du Système de Conversion Géodésique
    Private Type tSCG
       avProcess As Variant
       tInitial As tProjection
       tTrans As tTransformation
       tFinal As tProjection
    End Type
    Private Type t_XYZ
       dX As Double
       dY As Double
       dZ As Double
    End Type
    Private gdpi As Double
    Private gbInit As Boolean
    Private gsErreur As String
    Private gtXYZ As t_XYZ
    Private gtSCG As tSCG
    Private Sub class_initialize()
       gdpi = 4 * Atn(1)     'Calcul de pi
    End Sub
    'Sélection du type de conversion
    Public Sub TypeConversion(ByVal eDe As eSCG, ByVal eVers As eSCG)
       Dim tTmpSCG As tSCG
       Dim tTmpXYZ As t_XYZ
       If eDe <> eVers Then
          With tTmpSCG
             'Récupère le processus de conversion
             .avProcess = SetConversion(eDe, eVers)
             'Conversion possible
             If Not IsNull(.avProcess) Then
                'Définir les systèmes
                SetProjection .tInitial, eDe
                SetProjection .tFinal, eVers
                'Définir l'éventuelle transformation
                If Not IsNull(.avProcess(eSchema.eTypeTrans)) Then
                   SetTransformation .tTrans, .avProcess(eSchema.eTypeTrans)
                End If
                gsErreur = vbNullString
                gbInit = True
             Else
                gsErreur = "Conversion non définie..."
                gbInit = False
             End If
          End With
       Else
          gsErreur = "Pas de conversion nécessaire..."
          gbInit = False
       End If
       gtSCG = tTmpSCG
       gtXYZ = tTmpXYZ
    End Sub
    'Conversion à partir des mètres ou des radians selon le système de conversion
    Public Sub CalculSCG(ByVal dX As Double, dY As Double)
       Dim tXYZ As t_XYZ
       With tXYZ
          If gbInit Then
             'Si passage de coordonnées planes vers geographiques
             If gtSCG.avProcess(eSchema.bPLAtoGEO) Then
                tXYZ = alg04(dX, dY, gtSCG.tInitial)
             Else
                'dx : Tenir compte du méridien d'origine
                .dX = dX + gtSCG.tInitial.dlambda0
                .dY = dY
             End If
             'Si passage de GEO1 vers GEO2
             If Not IsNull(gtSCG.avProcess(eSchema.eTypeTrans)) Then
                tXYZ = alg09(.dX, .dY, gtSCG.tInitial.tEl)   'GEO1 -> CAR1
                tXYZ = alg13(tXYZ, gtSCG.tTrans)           'CAR1 -> CAR2
                tXYZ = alg12(tXYZ, gtSCG.tFinal.tEl)       'CAR2 -> GEO2
             End If
             'Si passage de GEO vers PLA
             If gtSCG.avProcess(eSchema.bGEOtoPLA) Then
                tXYZ = alg03(.dX, .dY, gtSCG.tFinal)
             Else
                'dx : Tenir compte du méridien d'origine du système final
                .dX = .dX - gtSCG.tFinal.dlambda0
             End If
          Else
             gsErreur = "Système de conversion non initialisé..."
          End If
          gtXYZ.dX = .dX
          gtXYZ.dY = .dY
          gtXYZ.dZ = .dZ
       End With
    End Sub
    'Retourne le résultat : X  en mètre ou en radian (longitude)
    Public Property Get X() As Double
       X = gtXYZ.dX
    End Property
    'Retourne le résultat : Y  en mètre ou en radian (latitude)
    Public Property Get Y() As Double
       Y = gtXYZ.dY
    End Property
    Public Property Get pi() As Double
       pi = gdpi
    End Property
    Public Property Get IsErreur() As Boolean
       If Len(gsErreur) Then IsErreur = True
    End Property
    Public Property Get Erreur() As String
       Erreur = gsErreur
    End Property
    'alg01 - Appel par alg03 et alg54 - Calcul de la latitude isométrique à partir de la latitude
    Private Function alg01(ByVal dphi As Double, ByVal de As Double) As Double
       Dim dTmp As Double
       dTmp = de * Sin(dphi)
       alg01 = Log(Tan(gdpi / 4 + dphi / 2) * ((1 - dTmp) / (1 + dTmp)) ^ (de / 2))
    End Function
    'alg02 - Appel par algo04 - Calcul la latitude à partir de la latitude isométrique
    Private Function alg02(ByVal dphiIso As Double, ByVal de As Double, _
                           Optional ByVal depsilon As Double = 0.0000000001) As Double
       Dim dCurphi As Double, dLastphi As Double
       dCurphi = 2 * Atn(Exp(dphiIso)) - gdpi / 2
       Do
          dLastphi = dCurphi
          dCurphi = 2 * Atn(((1 + de * Sin(dLastphi)) / (1 - de * Sin(dLastphi))) ^ (de / 2) * Exp(dphiIso)) - gdpi / 2
       Loop Until Abs(dCurphi - dLastphi) < depsilon
       alg02 = dCurphi
    End Function
    'alg03 - Transformation de coordonnées géographiques en projection conique conforme de Lambert
    'Utilise la variable globale gtSCG pour les constantes de la projection finale
    Private Function alg03(ByVal dlambda As Double, ByVal dphi As Double, _
                           ByRef tProj As tProjection) As t_XYZ
       Dim dphiIso As Double, dTmp1 As Double, dtheta As Double
       With tProj
          dphiIso = alg01(dphi, .tEl.de)
          dTmp1 = .dc * Exp(-.dN * dphiIso)
          dtheta = .dN * (dlambda - .dlambda0)
          alg03.dX = .dXs + dTmp1 * Sin(dtheta)
          alg03.dY = .dYs - dTmp1 * Cos(dtheta)
       End With
    End Function
    'alg04 - Passage d'une projection Lambert vers des coordonnées géographiques
    'Utilise la variable globale gtSCG pour les constantes de la projection initiale
    Private Function alg04(ByVal dX As Double, ByVal dY As Double, _
                           ByRef tProj As tProjection, _
                           Optional ByVal depsilon As Double = 0.0000000001) As t_XYZ
       Dim dR As Double, dgamma As Double, dphiIso As Double
       With tProj
          dR = Sqr((dX - .dXs) ^ 2 + (dY - .dYs) ^ 2)
          dgamma = Atn((dX - .dXs) / (.dYs - dY))
          dphiIso = -1 / .dN * Log(Abs(dR / .dc))
          alg04.dX = .dlambda0 + dgamma / .dN
          alg04.dY = alg02(dphiIso, .tEl.de)
       End With
    End Function
    'alg21 - Appel par algo09 et alg54
    Private Function alg21(ByVal dphi As Double, ByVal da As Double, ByVal de As Double) As Double
       alg21 = da / Sqr(1 - de ^ 2 * Sin(dphi) ^ 2)
    End Function
    'alg09 - Passage de coordonnées géographiques à cartésiennes
    'Utilise la variable globale gtSCG pour l'ellipsoïde initiale
    Private Function alg09(ByVal dlambda As Double, ByVal dphi As Double, _
                           ByRef tEl As tEllipsoide) As t_XYZ
       Dim dN As Double
       dlambda = dlambda
       With tEl
          dN = alg21(dphi, .da, .de)
          alg09.dX = (dN + .dh) * Cos(dphi) * Cos(dlambda)
          alg09.dY = (dN + .dh) * Cos(dphi) * Sin(dlambda)
          alg09.dZ = (dN * (1 - .de ^ 2) + .dh) * Sin(dphi)
       End With
    End Function
    'alg12 - Passage de coordonnées cartésiennes à géographiques
    'Utilise la variable globale gtSCG pour l'ellipsoïde finale
    Private Function alg12(ByRef tXYZ As t_XYZ, _
                           ByRef tEl As tEllipsoide, _
                           Optional ByVal depsilon As Double = 0.0000000001) As t_XYZ
       Dim dCurphi As Double, dLastphi As Double, dTmp1 As Double, dTmp2 As Double
       Dim deCarre As Double, da As Double
       With tEl
          deCarre = .de ^ 2
          da = .da
       End With
       With tXYZ
          alg12.dX = Atn(.dY / .dX)
          dTmp1 = Sqr(.dX ^ 2 + .dY ^ 2)
          dTmp2 = da * deCarre
          dCurphi = Atn(.dZ / (dTmp1 * (1 - (dTmp2 / Sqr(.dX ^ 2 + .dY ^ 2 + .dZ ^ 2)))))
          Do
             dLastphi = dCurphi
             dCurphi = Atn(.dZ / (dTmp1 * (1 - (dTmp2 * Cos(dLastphi) / _
                                                (dTmp1 * Sqr(1 - deCarre * Sin(dLastphi) ^ 2))))))
          Loop Until Abs(dCurphi - dLastphi) < depsilon
          alg12.dY = dCurphi
          alg12.dZ = dTmp1 / Cos(dCurphi) - (da / Sqr(1 - deCarre * Sin(dLastphi) ^ 2))
       End With
    End Function
    'alg13 - Passage d'un SG à l'autre par coordonnées cartésiennes
    'Utilise la variable globale gtSCG pour la transformation
    'Modif algo : passage d'un facteur d'échelle additionné de 1
    Private Function alg13(ByRef tXYZ As t_XYZ, ByRef tTrans As tTransformation) As t_XYZ
       With tTrans
          alg13.dX = .dTx + tXYZ.dX * .dFacteurEchelle + tXYZ.dZ * .dRy - tXYZ.dY * .dRz
          alg13.dY = .dTy + tXYZ.dY * .dFacteurEchelle + tXYZ.dX * .dRz - tXYZ.dZ * .dRx
          alg13.dZ = .dTz + tXYZ.dZ * .dFacteurEchelle + tXYZ.dY * .dRx - tXYZ.dX * .dRy
       End With
    End Function
    'alg54 - Permet de calculer les constantes d'une projection conique conforme dans le cas sécant
    Private Sub alg54(ByRef tProj As tProjection, ByVal dX0 As Double, ByVal dY0 As Double)
       Dim dTmp1 As Double, dLatIso1 As Double
       With tProj
          dTmp1 = alg21(.dphi1, .tEl.da, .tEl.de) * Cos(.dphi1)
          dLatIso1 = alg01(.dphi1, .tEl.de)
          .dN = Log(alg21(.dphi2, .tEl.da, .tEl.de) * Cos(.dphi2) / dTmp1) / _
                (dLatIso1 - alg01(.dphi2, .tEl.de))
          .dc = (dTmp1 / .dN) * Exp(.dN * dLatIso1)
          .dXs = dX0
          If Arrondi(.dphi0, 9) <> Arrondi(gdpi / 2, 9) Then
             .dYs = dY0 + .dc * Exp(-.dN * alg01(.dphi0, .tEl.de))
          Else
             .dYs = dY0
          End If
       End With
    End Sub
    Private Sub SetProjection(ByRef tProj As tProjection, ByVal eType As eSCG)
       With tProj
          .eType = eType
          'Paramètres du Système géodésique
          .tEl.dh = 100 'Hauteur au dessus de l'ellipsoïde, valeur par défaut
          Select Case eType
          Case eSCG.NTF_Lambert_I, _
               eSCG.NTF_Lambert_II, _
               eSCG.NTF_Lambert_III, _
               eSCG.NTF_Lambert_IV, _
               eSCG.NTF_Lambert_II_Etendu, _
               eSCG.NTF_Paris_Geo                      'Ellipsoïde de Clarke 1880
             .dlambda0 = DMSToRadian(2, 20, 14.025)    'Paris = 2°20'14,025 E Greenwich
             .tEl.da = 6378249.2
             .tEl.db = 6356515#
             .tEl.de = CalculPremiereExcentricite(.tEl.da, .tEl.db)   '0.08248325676
          Case eSCG.RGF93_Lambert_93, eSCG.RGF93_Geo   'Ellipsoïde IAG_GRS80
             .dlambda0 = DegreDecToRadian(3)
             .tEl.da = 6378137
             .tEl.df = 1 / 298.257222101
             .tEl.db = CalculDemiPetitAxe(.tEl.da, .tEl.df)
             .tEl.de = CalculPremiereExcentricite(.tEl.da, .tEl.db)
          Case eSCG.WGS84_Geo                          'Ellipsoïde WGS84
             .dlambda0 = 0
             .tEl.da = 6378137
             .tEl.df = 1 / 298.257223563
             .tEl.db = CalculDemiPetitAxe(.tEl.da, .tEl.df)
             .tEl.de = CalculPremiereExcentricite(.tEl.da, .tEl.db)   '0.08181919106
          Case eSCG.ETRS89_Geo, eSCG.ETRS89_Lambert08  'Ellipsoïde GRS80
             .tEl.da = 6378137
             .tEl.df = 1 / 298.257222101
             .tEl.db = CalculDemiPetitAxe(.tEl.da, .tEl.df)
             .tEl.de = CalculPremiereExcentricite(.tEl.da, .tEl.db)   '0.08181919106
          Case eSCG.ED50_Geo, eSCG.BD72_Geo, eSCG.BD72_Lambert72   'Ellipsoïde Hayford 1909 et International 1924 ?
             .tEl.da = 6378388
             .tEl.df = 1 / 297#
             .tEl.db = CalculDemiPetitAxe(.tEl.da, .tEl.df)
             .tEl.de = CalculPremiereExcentricite(.tEl.da, .tEl.db)   '0.08199188998
          End Select
          'Paramètres de la projection
          Select Case eType
          Case eSCG.NTF_Lambert_I            'Nord France
             .dphi0 = GradeToRadian(55#)
             .dphi1 = DMSToRadian(48, 35, 54.682)
             .dphi2 = DMSToRadian(50, 23, 45.282)
             .dN = 0.7604059656
             .dc = 11603796.98
             .dXs = 600000#
             .dYs = 5657616.674
          Case eSCG.NTF_Lambert_II           'Centre France
             .dphi0 = GradeToRadian(52#)
             .dphi1 = DMSToRadian(45, 53, 56.108)
             .dphi2 = DMSToRadian(47, 41, 45.652)
             .dN = 0.7289686274
             .dc = 11745793.39
             .dXs = 600000#
             .dYs = 6199695.768
          Case eSCG.NTF_Lambert_III          'Sud France
             .dphi0 = GradeToRadian(49#)
             .dphi1 = DMSToRadian(43, 11, 57.449)
             .dphi2 = DMSToRadian(44, 59, 45.938)
             .dN = 0.6959127966
             .dc = 11947992.52
             .dXs = 600000#
             .dYs = 6791905.085
          Case eSCG.NTF_Lambert_IV           'Corse
             .dphi0 = GradeToRadian(46.85)
             .dphi1 = DMSToRadian(41, 33, 37.396)
             .dphi2 = DMSToRadian(42, 46, 3.588)
             .dN = 0.6712679322
             .dc = 12136281.99
             .dXs = 234.358
             .dYs = 7239161.542
          Case eSCG.NTF_Lambert_II_Etendu    'France entière
             .dphi0 = GradeToRadian(52#)
             .dphi1 = DMSToRadian(45, 53, 56.108)
             .dphi2 = DMSToRadian(47, 41, 45.652)
             .dN = 0.7289686274
             .dc = 11745793.39
             .dXs = 600000#
             .dYs = 8199695.768
          Case eSCG.RGF93_Lambert_93          'France entière
             .dlambda0 = DegreDecToRadian(3)
             .dphi0 = DMSToRadian(46, 30)
             .dphi1 = DegreDecToRadian(44)
             .dphi2 = DegreDecToRadian(49)
             .dN = 0.725607765
             .dc = 11754255.426
             .dXs = 700000#
             .dYs = 12655612.05
          Case eSCG.BD72_Lambert72            'Belgique
             .dlambda0 = DMSToRadian(4, 22, 2.952)
             .dphi0 = DegreDecToRadian(90)
             .dphi1 = DMSToRadian(49, 50, 0.00204)
             .dphi2 = DMSToRadian(51, 10, 0.00204)
             'Calcul les constantes
             alg54 tProj, 150000.013, 5400088.438
          Case eSCG.ETRS89_Lambert08          'Belgique
             .dlambda0 = DMSToRadian(4, 21, 33.177)
             .dphi0 = DMSToRadian(50, 47, 52.134)
             .dphi1 = DMSToRadian(49, 50)
             .dphi2 = DMSToRadian(51, 10)
             'Calcul les constantes
             alg54 tProj, 649328#, 665262#
          End Select
       End With
    End Sub
    'Paramètres de transformation d'un système à l'autre
    Private Sub SetTransformation(ByRef tTrans As tTransformation, ByVal eTrans As eTypeTrans)
       With tTrans
          'Selon convention de l'IERS : Coordinate Frame Rotation ?
          'Par défaut
          .dFacteurEchelle = 1
          Select Case eTrans
          Case eTypeTrans.NTFtoRGF93, eTypeTrans.NTFtoWGS84, _
               eTypeTrans.RGF93toNTF, eTypeTrans.WGS84toNTF
             .dTx = -168
             .dTy = -60
             .dTz = 320
             If eTrans = eTypeTrans.RGF93toNTF Or eTrans = eTypeTrans.WGS84toNTF Then
                TransformationInverse tTrans
             End If
          Case eTypeTrans.NTFtoED50, eTypeTrans.ED50toNTF
             .dTx = -84
             .dTy = 37
             .dTz = 437
             If eTrans = eTypeTrans.ED50toNTF Then
                TransformationInverse tTrans
             End If
          Case eTypeTrans.ED50toWGS84, eTypeTrans.ED50toRGF93, _
               eTypeTrans.RGF93toED50, eTypeTrans.WGS84toED50
             .dTx = -84
             .dTy = -97
             .dTz = -117
             If eTrans = eTypeTrans.RGF93toED50 Or eTrans = eTypeTrans.WGS84toED50 Then
                TransformationInverse tTrans
             End If
          Case eTypeTrans.ETRS89toBD72, eTypeTrans.BD72toETRS89
             .dTx = 106.868628
             .dTy = -52.297783
             .dTz = 103.723893
             .dRx = DMSToRadian(0, 0, 0.33657, True)
             .dRy = DMSToRadian(0, 0, 0.456955)
             .dRz = DMSToRadian(0, 0, 1.842183, True)
             .dFacteurEchelle = 1 + 0.0000012747
             If eTrans = eTypeTrans.BD72toETRS89 Then
                TransformationInverse tTrans
             End If
          Case eTypeTrans.RGF93toWGS84, eTypeTrans.WGS84toRGF93
             'pas de transformation entre ces systèmes
          End Select
       End With
    End Sub
    'Détermine les paramètres de la transformation inverse
    Private Sub TransformationInverse(ByRef tTrans As tTransformation)
       With tTrans
          .dTx = -.dTx
          .dTy = -.dTy
          .dTz = -.dTz
          .dRx = -.dRx
          .dRy = -.dRy
          .dRz = -.dRz
          If .dFacteurEchelle <> 0 Then .dFacteurEchelle = 1 / .dFacteurEchelle
       End With
    End Sub
    Post suivant : Suite du code...

    Philippe

  7. #7
    Membre Expert

    Inscrit en
    avril 2006
    Messages
    1 390
    Détails du profil
    Informations forums :
    Inscription : avril 2006
    Messages : 1 390
    Points : 1 961
    Points
    1 961

    Par défaut

    Suite du code de la version 1.03...

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
    410
    411
    412
    413
    414
    415
    416
    417
    418
    419
    420
    421
    422
    423
    424
    425
    426
    427
    428
    429
    430
    431
    432
    433
    434
    435
    436
    437
    438
    439
    440
    441
    442
    443
    444
    445
    446
    447
    448
    449
    450
    451
    452
    453
    454
    455
    456
    457
    458
    459
    460
    461
    462
    463
    464
    465
    466
    467
    468
    469
    470
    471
    472
    473
    474
    475
    476
    477
    478
    479
    480
    481
    482
    483
    484
    485
    486
    487
    488
    489
    490
    491
    492
    493
    494
    495
    496
    497
    498
    499
    500
    501
    502
    503
    504
    505
    506
    507
    508
    509
    510
     
     
    Private Function SetConversion(ByVal eDe As eSCG, ByVal eVers As eSCG) As Variant
       Dim avC(0 To 63) As Variant
       Dim i As Integer
       avC(0) = VBA.Array(eSCG.NTF_Lambert_I, eSCG.NTF_Paris_Geo, True, Null, False)
       avC(1) = VBA.Array(eSCG.NTF_Lambert_I, eSCG.NTF_Lambert_II_Etendu, True, Null, True)
       avC(2) = VBA.Array(eSCG.NTF_Lambert_I, eSCG.RGF93_Geo, True, eTypeTrans.NTFtoRGF93, False)
       avC(3) = VBA.Array(eSCG.NTF_Lambert_I, eSCG.RGF93_Lambert_93, True, eTypeTrans.NTFtoRGF93, True)
       avC(4) = VBA.Array(eSCG.NTF_Lambert_I, eSCG.ED50_Geo, True, eTypeTrans.NTFtoED50, False)
       avC(5) = VBA.Array(eSCG.NTF_Lambert_I, eSCG.WGS84_Geo, True, eTypeTrans.NTFtoWGS84, False)
       avC(6) = VBA.Array(eSCG.NTF_Lambert_II, eSCG.NTF_Paris_Geo, True, Null, False)
       avC(7) = VBA.Array(eSCG.NTF_Lambert_II, eSCG.NTF_Lambert_II_Etendu, True, Null, True)
       avC(8) = VBA.Array(eSCG.NTF_Lambert_II, eSCG.RGF93_Geo, True, eTypeTrans.NTFtoRGF93, False)
       avC(9) = VBA.Array(eSCG.NTF_Lambert_II, eSCG.RGF93_Lambert_93, True, eTypeTrans.NTFtoRGF93, True)
       avC(10) = VBA.Array(eSCG.NTF_Lambert_II, eSCG.ED50_Geo, True, eTypeTrans.NTFtoED50, False)
       avC(11) = VBA.Array(eSCG.NTF_Lambert_II, eSCG.WGS84_Geo, True, eTypeTrans.NTFtoWGS84, False)
       avC(12) = VBA.Array(eSCG.NTF_Lambert_III, eSCG.NTF_Paris_Geo, True, Null, False)
       avC(13) = VBA.Array(eSCG.NTF_Lambert_III, eSCG.NTF_Lambert_II_Etendu, True, Null, True)
       avC(14) = VBA.Array(eSCG.NTF_Lambert_III, eSCG.RGF93_Geo, True, eTypeTrans.NTFtoRGF93, False)
       avC(15) = VBA.Array(eSCG.NTF_Lambert_III, eSCG.RGF93_Lambert_93, True, eTypeTrans.NTFtoRGF93, True)
       avC(16) = VBA.Array(eSCG.NTF_Lambert_III, eSCG.ED50_Geo, True, eTypeTrans.NTFtoED50, False)
       avC(17) = VBA.Array(eSCG.NTF_Lambert_III, eSCG.WGS84_Geo, True, eTypeTrans.NTFtoWGS84, False)
       avC(18) = VBA.Array(eSCG.NTF_Lambert_IV, eSCG.NTF_Paris_Geo, True, Null, False)
       avC(19) = VBA.Array(eSCG.NTF_Lambert_IV, eSCG.NTF_Lambert_II_Etendu, True, Null, True)
       avC(20) = VBA.Array(eSCG.NTF_Lambert_IV, eSCG.RGF93_Geo, True, eTypeTrans.NTFtoRGF93, False)
       avC(21) = VBA.Array(eSCG.NTF_Lambert_IV, eSCG.RGF93_Lambert_93, True, eTypeTrans.NTFtoRGF93, True)
       avC(22) = VBA.Array(eSCG.NTF_Lambert_IV, eSCG.ED50_Geo, True, eTypeTrans.NTFtoED50, False)
       avC(23) = VBA.Array(eSCG.NTF_Lambert_IV, eSCG.WGS84_Geo, True, eTypeTrans.NTFtoWGS84, False)
       avC(24) = VBA.Array(eSCG.NTF_Lambert_II_Etendu, eSCG.NTF_Paris_Geo, True, Null, False)
       avC(25) = VBA.Array(eSCG.NTF_Lambert_II_Etendu, eSCG.RGF93_Geo, True, eTypeTrans.NTFtoRGF93, False)
       avC(26) = VBA.Array(eSCG.NTF_Lambert_II_Etendu, eSCG.RGF93_Lambert_93, True, eTypeTrans.NTFtoRGF93, True)
       avC(27) = VBA.Array(eSCG.NTF_Lambert_II_Etendu, eSCG.ED50_Geo, True, eTypeTrans.NTFtoED50, False)
       avC(28) = VBA.Array(eSCG.NTF_Lambert_II_Etendu, eSCG.WGS84_Geo, True, eTypeTrans.NTFtoWGS84, False)
       avC(29) = VBA.Array(eSCG.NTF_Paris_Geo, eSCG.NTF_Lambert_II_Etendu, False, Null, True)
       avC(30) = VBA.Array(eSCG.NTF_Paris_Geo, eSCG.RGF93_Geo, False, eTypeTrans.NTFtoRGF93, False)
       avC(31) = VBA.Array(eSCG.NTF_Paris_Geo, eSCG.RGF93_Lambert_93, False, eTypeTrans.NTFtoRGF93, True)
       avC(32) = VBA.Array(eSCG.NTF_Paris_Geo, eSCG.ED50_Geo, False, eTypeTrans.NTFtoED50, False)
       avC(33) = VBA.Array(eSCG.NTF_Paris_Geo, eSCG.WGS84_Geo, False, eTypeTrans.NTFtoWGS84, False)
       avC(34) = VBA.Array(eSCG.RGF93_Geo, eSCG.NTF_Lambert_II_Etendu, False, eTypeTrans.RGF93toNTF, True)
       avC(35) = VBA.Array(eSCG.RGF93_Geo, eSCG.NTF_Paris_Geo, False, eTypeTrans.RGF93toNTF, False)
       avC(36) = VBA.Array(eSCG.RGF93_Geo, eSCG.RGF93_Lambert_93, False, Null, True)
       avC(37) = VBA.Array(eSCG.RGF93_Geo, eSCG.ED50_Geo, False, eTypeTrans.RGF93toED50, False)
       avC(38) = VBA.Array(eSCG.RGF93_Geo, eSCG.WGS84_Geo, False, eTypeTrans.RGF93toWGS84, False)
       avC(39) = VBA.Array(eSCG.RGF93_Lambert_93, eSCG.NTF_Paris_Geo, True, eTypeTrans.RGF93toNTF, False)
       avC(40) = VBA.Array(eSCG.RGF93_Lambert_93, eSCG.NTF_Lambert_II_Etendu, True, eTypeTrans.RGF93toNTF, True)
       avC(41) = VBA.Array(eSCG.RGF93_Lambert_93, eSCG.RGF93_Geo, True, Null, False)
       avC(42) = VBA.Array(eSCG.RGF93_Lambert_93, eSCG.ED50_Geo, True, eTypeTrans.RGF93toED50, False)
       avC(43) = VBA.Array(eSCG.RGF93_Lambert_93, eSCG.WGS84_Geo, True, eTypeTrans.RGF93toWGS84, False)
       avC(44) = VBA.Array(eSCG.ED50_Geo, eSCG.NTF_Paris_Geo, False, eTypeTrans.ED50toNTF, False)
       avC(45) = VBA.Array(eSCG.ED50_Geo, eSCG.NTF_Lambert_II_Etendu, False, eTypeTrans.ED50toNTF, True)
       avC(46) = VBA.Array(eSCG.ED50_Geo, eSCG.RGF93_Geo, False, eTypeTrans.ED50toRGF93, False)
       avC(47) = VBA.Array(eSCG.ED50_Geo, eSCG.RGF93_Lambert_93, False, eTypeTrans.ED50toRGF93, True)
       avC(48) = VBA.Array(eSCG.ED50_Geo, eSCG.WGS84_Geo, False, eTypeTrans.ED50toWGS84, False)
       avC(49) = VBA.Array(eSCG.WGS84_Geo, eSCG.NTF_Paris_Geo, False, eTypeTrans.WGS84toNTF, False)
       avC(50) = VBA.Array(eSCG.WGS84_Geo, eSCG.NTF_Lambert_II_Etendu, False, eTypeTrans.WGS84toNTF, True)
       avC(51) = VBA.Array(eSCG.WGS84_Geo, eSCG.RGF93_Geo, False, eTypeTrans.WGS84toRGF93, False)
       avC(52) = VBA.Array(eSCG.WGS84_Geo, eSCG.RGF93_Lambert_93, False, eTypeTrans.WGS84toRGF93, True)
       avC(53) = VBA.Array(eSCG.WGS84_Geo, eSCG.ED50_Geo, False, eTypeTrans.WGS84toED50, False)
       avC(54) = VBA.Array(eSCG.BD72_Lambert72, eSCG.ETRS89_Lambert08, True, eTypeTrans.BD72toETRS89, True)
       avC(55) = VBA.Array(eSCG.BD72_Lambert72, eSCG.BD72_Geo, True, Null, False)
       avC(56) = VBA.Array(eSCG.BD72_Lambert72, eSCG.ETRS89_Geo, True, eTypeTrans.BD72toETRS89, False)
       avC(57) = VBA.Array(eSCG.BD72_Geo, eSCG.ETRS89_Geo, False, eTypeTrans.BD72toETRS89, False)
       avC(58) = VBA.Array(eSCG.ETRS89_Lambert08, eSCG.BD72_Lambert72, True, eTypeTrans.ETRS89toBD72, True)
       avC(59) = VBA.Array(eSCG.ETRS89_Lambert08, eSCG.BD72_Geo, True, eTypeTrans.ETRS89toBD72, False)
       avC(60) = VBA.Array(eSCG.ETRS89_Lambert08, eSCG.ETRS89_Geo, True, Null, False)
       avC(61) = VBA.Array(eSCG.ETRS89_Geo, eSCG.BD72_Lambert72, False, eTypeTrans.ETRS89toBD72, True)
       avC(62) = VBA.Array(eSCG.ETRS89_Geo, eSCG.BD72_Geo, False, eTypeTrans.ETRS89toBD72, False)
       avC(63) = VBA.Array(eSCG.ETRS89_Geo, eSCG.ETRS89_Lambert08, False, Null, True)
       For i = 0 To UBound(avC)
          If avC(i)(eSchema.eInitial) = eDe And avC(i)(eSchema.eFinal) = eVers Then
             SetConversion = avC(i)
             Exit For
          End If
       Next i
    End Function
    Private Function CalculDemiPetitAxe(ByVal da As Double, ByVal df As Double) As Double
       CalculDemiPetitAxe = da * (1 - df)
    End Function
    Private Function CalculPremiereExcentricite(ByVal da As Double, ByVal db As Double) As Double
       Dim daCarre As Double
       daCarre = da ^ 2
       CalculPremiereExcentricite = Sqr((daCarre - db ^ 2) / daCarre)
    End Function
    Public Function GradeToRadian(ByVal dAngle As Double)
       GradeToRadian = gdpi * dAngle / 200
    End Function
    Public Function RadianToGrade(ByVal dAngle As Double)
       RadianToGrade = 200 * dAngle / gdpi
    End Function
    Public Function DegreDecToRadian(ByVal dAngle As Double)
       DegreDecToRadian = gdpi * dAngle / 180
    End Function
    Public Function RadianToDegreDec(ByVal dAngle As Double)
       RadianToDegreDec = 180 * dAngle / gdpi
    End Function
    Public Function DMSToDegreDec(ByVal iDegre As Integer, Optional ByVal byMin As Byte = 0, _
                                  Optional ByVal fSec As Single = 0, _
                                  Optional bNegatif As Boolean = False) As Double
       If byMin < 60 And fSec < 60 Then
          DMSToDegreDec = Abs(iDegre) + byMin / 60 + Abs(fSec) / 3600
          If bNegatif Then DMSToDegreDec = -DMSToDegreDec
       End If
    End Function
    Public Function AngleDMSToDegreDec(ByVal dAngle As Double) As Double
       Dim fSec As Single
       Dim iDegre As Integer, iMin As Integer, iSigne As Integer
       iSigne = Sgn(dAngle)
       dAngle = Abs(dAngle)
       iDegre = Int(dAngle)
       iMin = Int((dAngle - iDegre) * 100)
       fSec = (dAngle - iDegre - iMin / 100) * 10000
       AngleDMSToDegreDec = (iDegre + iMin / 60 + fSec / 3600) * iSigne
    End Function
    Public Function DMSToRadian(ByVal iDegre As Integer, Optional ByVal byMin As Byte = 0, _
                                Optional ByVal fSec As Single = 0, _
                                Optional bNegatif As Boolean = False) As Double
       DMSToRadian = DegreDecToRadian(DMSToDegreDec(iDegre, byMin, fSec, bNegatif))
    End Function
    Public Function AngleDMSToRadian(ByVal dAngle As Double) As Double
       AngleDMSToRadian = DegreDecToRadian(AngleDMSToDegreDec(dAngle))
    End Function
    Public Function DegreDecToAngleDMS(ByVal dAngle As Double) As Double
       Dim iDegre As Integer, iMin As Integer, iSigne As Integer
       Dim fSec As Single
       iSigne = Sgn(dAngle)
       dAngle = Abs(dAngle)
       iDegre = Int(dAngle)
       iMin = Int((dAngle - iDegre) * 60)
       fSec = (dAngle - iDegre - iMin / 60) * 3600
       DegreDecToAngleDMS = Arrondi((iDegre + (iMin + fSec / 100) / 100) * iSigne, 7)
    End Function
    Public Function AngleDMSToString(ByVal dAngle As Double, ByVal bLatitude As Boolean) As String
       Dim iDegre As Integer, iMin As Integer, iSigne As Integer
       Dim fSec As Single
       Dim s As String
       iSigne = Sgn(dAngle)
       dAngle = Abs(dAngle)
       iDegre = Int(dAngle)
       iMin = Int((dAngle - iDegre) * 100)
       fSec = (dAngle - iDegre - iMin / 100) * 10000
       s = iDegre & "°" & format(iMin, "00'") & format(fSec, "00.0##''")
       If iSigne < 0 Then
          s = s & IIf(bLatitude, "S", "W")
       Else
          s = s & IIf(bLatitude, "N", "E")
       End If
       AngleDMSToString = s
    End Function
    Public Function RadianToStringDMS(ByVal dAngle As Double, ByVal bLatitude As Boolean) As String
       RadianToStringDMS = AngleDMSToString(DegreDecToAngleDMS(RadianToDegreDec(dAngle)), bLatitude)
    End Function
    Public Function Arrondi(ByVal dVal As Double, Optional ByVal iDec As Integer = 0) As Double
       Arrondi = Int((dVal * (10 ^ iDec)) + 0.5) / (10 ^ iDec)
    End Function
    Public Function DistanceKm(ByVal dRadLon1 As Double, ByVal dRadLat1 As Double, _
                               ByVal dRadLon2 As Double, ByVal dRadLat2 As Double) As Double
       DistanceKm = 6371 * ArcCosRad(Cos(dRadLat1) * Cos(dRadLat2) * Cos(dRadLon2 - dRadLon1) + _
                                     (Sin(dRadLat1) * Sin(dRadLat2)))
    End Function
    Private Function ArcCosRad(dRadian As Double) As Double
       If dRadian > -1 And dRadian < 1 Then
          ArcCosRad = Atn(-dRadian / Sqr(-dRadian * dRadian + 1)) + gdpi / 2
       ElseIf dRadian = -1 Then
          ArcCosRad = gdpi
       End If
    End Function
    #If CCTEST Then
    Public Function TestAngles()
       Dim sTabs As String
       sTabs = vbTab & vbTab
    Debug.Print "--- Vérification des conversions d'angles ---"
    Debug.Print vbTab & "+ Grade -> Radian"
    Debug.Print sTabs & "Entrée : " & 0 & " - Attendu : " & 0 & " - Obtenu : " & GradeToRadian(0)
    Debug.Print sTabs & "Entrée : " & 200 & " - Attendu : " & gdpi & " - Obtenu : " & GradeToRadian(200)
    Debug.Print sTabs & "Entrée : " & -200 & " - Attendu : " & -gdpi & " - Obtenu : " & GradeToRadian(-200)
    Debug.Print sTabs & "Entrée : " & 600 & " - Attendu : " & (3 * gdpi) & " - Obtenu : " & GradeToRadian(600)
    Debug.Print vbTab & "+ Radian -> Grade"
    Debug.Print sTabs & "Entrée : " & 0 & " - Attendu : " & 0 & " - Obtenu : " & RadianToGrade(0)
    Debug.Print sTabs & "Entrée : " & "pi" & " - Attendu : " & 200 & " - Obtenu : " & RadianToGrade(gdpi)
    Debug.Print sTabs & "Entrée : " & "-pi" & " - Attendu : " & -200 & " - Obtenu : " & RadianToGrade(-gdpi)
    Debug.Print sTabs & "Entrée : " & (3 * gdpi) & " - Attendu : " & 600 & " - Obtenu : " & RadianToGrade(3 * gdpi)
    Debug.Print vbTab & "+ Degré décimal -> Radian"
    Debug.Print sTabs & "Entrée : " & 0 & " - Attendu : " & 0 & " - Obtenu : " & DegreDecToRadian(0)
    Debug.Print sTabs & "Entrée : " & 180 & " - Attendu : " & "pi" & " - Obtenu : " & DegreDecToRadian(180)
    Debug.Print sTabs & "Entrée : " & -180 & " - Attendu : " & "-pi" & " - Obtenu : " & DegreDecToRadian(-180)
    Debug.Print sTabs & "Entrée : " & 540 & " - Attendu : " & (3 * gdpi) & " - Obtenu : " & DegreDecToRadian(540)
    Debug.Print vbTab & "+ Radian -> Degré décimal"
    Debug.Print sTabs & "Entrée : " & 0 & " - Attendu : " & 0 & " - Obtenu : " & RadianToDegreDec(0)
    Debug.Print sTabs & "Entrée : " & "pi" & " - Attendu : " & 180 & " - Obtenu : " & RadianToDegreDec(gdpi)
    Debug.Print sTabs & "Entrée : " & "-pi" & " - Attendu : " & -180 & " - Obtenu : " & RadianToDegreDec(-gdpi)
    Debug.Print sTabs & "Entrée : " & (3 * gdpi) & " - Attendu : " & 540 & " - Obtenu : " & RadianToDegreDec(3 * gdpi)
    Debug.Print vbTab & "+ DMS(Deg,Min,Sec) -> Degré décimal"
    Debug.Print sTabs & "Entrée : " & 0 & " - Attendu : " & 0 & " - Obtenu : " & DMSToDegreDec(0)
    Debug.Print sTabs & "Entrée : " & 180 & " - Attendu : " & 180 & " - Obtenu : " & DMSToDegreDec(180)
    Debug.Print sTabs & "Entrée : " & "45°35'25.566''" & " - Attendu : " & 45.590435 & " - Obtenu : " & Arrondi(DMSToDegreDec(45, 35, 25.567), 6)
    Debug.Print sTabs & "Entrée : " & "-45°35'25.566''" & " - Attendu : " & -45.590435 & " - Obtenu : " & Arrondi(DMSToDegreDec(-45, 35, 25.566, True), 6)
    Debug.Print sTabs & "Entrée : " & "-45°75'25.566''" & " - Attendu : " & 0 & " car erreur ! - Obtenu : " & Arrondi(DMSToDegreDec(-45, 75, 25.566, True), 6)
    Debug.Print sTabs & "Entrée : " & "-45°35'85.566''" & " - Attendu : " & 0 & " car erreur ! - Obtenu : " & Arrondi(DMSToDegreDec(-45, 35, 85.566, True), 6)
    Debug.Print vbTab & "+ Angle DMS (Degre.mmssxxx) -> Degré décimal"
    Debug.Print sTabs & "Entrée : " & 0 & " - Attendu : " & 0 & " - Obtenu : " & AngleDMSToDegreDec(0)
    Debug.Print sTabs & "Entrée : " & 180 & " - Attendu : " & 180 & " - Obtenu : " & AngleDMSToDegreDec(180)
    Debug.Print sTabs & "Entrée : " & 45.3525566 & " - Attendu : " & 45.590435 & " - Obtenu : " & Arrondi(AngleDMSToDegreDec(45.3525566), 6)
    Debug.Print sTabs & "Entrée : " & -45.3525566 & " - Attendu : " & -45.590435 & " - Obtenu : " & Arrondi(AngleDMSToDegreDec(-45.3525566), 6)
    Debug.Print vbTab & "+ Degré décimal -> Angle DMS (Degre.mmssxxx)"
    Debug.Print sTabs & "Entrée : " & 0 & " - Attendu : " & 0 & " - Obtenu : " & DegreDecToAngleDMS(0)
    Debug.Print sTabs & "Entrée : " & 180 & " - Attendu : " & 180 & " - Obtenu : " & DegreDecToAngleDMS(180)
    Debug.Print sTabs & "Entrée : " & 45.590435 & " - Attendu : " & 45.3525566 & " - Obtenu : " & Arrondi(DegreDecToAngleDMS(45.590435), 7)
    Debug.Print sTabs & "Entrée : " & -45.590435 & " - Attendu : " & -45.3525566 & " - Obtenu : " & Arrondi(DegreDecToAngleDMS(-45.590435), 7)
    Debug.Print vbTab & "+ Angle DMS (Degre.mmssxxx) -> String"
    Debug.Print sTabs & "Entrée : " & 0 & " Lat - Attendu : " & "0°00'00,0''N" & " - Obtenu : " & AngleDMSToString(0, True)
    Debug.Print sTabs & "Entrée : " & 45 & " Lon - Attendu : " & "45°00'00,0''E" & " - Obtenu : " & AngleDMSToString(45, False)
    Debug.Print sTabs & "Entrée : " & 45.590435 & " Lat - Attendu : " & "45°59'04,35''N" & " - Obtenu : " & AngleDMSToString(45.590435, True)
    Debug.Print sTabs & "Entrée : " & -45.3525566 & " Lat - Attendu : " & "45°35'25,566''S" & " - Obtenu : " & AngleDMSToString(-45.3525566, True)
    Debug.Print "---"
    End Function
    Public Sub TestConversions()
    Debug.Print "--- Vérification de certaines conversions ---"
    Debug.Print vbTab & "+ NTF méridien de Paris -> ED50 Greenwich"
       Test NTF_Paris_Geo, ED50_Geo, 6, 54, "7°44'16,4''", "48°36'03,3''", gr, dms
    Debug.Print vbTab & "+ NTF méridien de Paris -> WGS84"
       Test NTF_Paris_Geo, WGS84_Geo, 6, 54, "7°44'12,2''", "48°35'59,9''", gr, dms
    Debug.Print vbTab & "+ NTF méridien de Paris -> NTF Lambert II étendu"
       Test NTF_Paris_Geo, NTF_Lambert_II_Etendu, 6, 54, "998137m", "2413822m", gr, m, 0
    Debug.Print vbTab & "+ NTF méridien de Paris -> RGF Lambert 93"
       Test NTF_Paris_Geo, RGF93_Lambert_93, 6, 54, "1049052m", "6843777m", gr, m, 0
    Debug.Print vbTab & "+ NTF Lambert I -> ED50 Greenwich"
       Test NTF_Lambert_I, ED50_Geo, 997960, 114185, "7°44'16,4''", "48°36'03,3''", m, dms
    Debug.Print vbTab & "+ NTF Lambert I -> WGS84"
       Test NTF_Lambert_I, WGS84_Geo, 997960, 114185, "7°44'12,2''", "48°35'59,9''", m, dms
    Debug.Print vbTab & "+ NTF Lambert I -> NTF Lambert II étendu"
       Test NTF_Lambert_I, NTF_Lambert_II_Etendu, 997960, 114185, "998137m", "2413822m", m, m, 0
    Debug.Print vbTab & "+ NTF Lambert I -> RGF Lambert 93"
       Test NTF_Lambert_I, RGF93_Lambert_93, 997960, 114185, "1049052m", "6843777m", m, m, 0
    Debug.Print vbTab & "+ NTF Lambert II étendu -> ED50 Greenwich"
       Test NTF_Lambert_II_Etendu, ED50_Geo, 998137, 2413822, "7°44'16,4''", "48°36'03,3''", m, dms
    Debug.Print vbTab & "+ NTF Lambert II étendu -> WGS84"
       Test NTF_Lambert_II_Etendu, WGS84_Geo, 998137, 2413822, "7°44'12,2''", "48°35'59,9''", m, dms
    Debug.Print vbTab & "+ NTF Lambert II étendu -> NTF méridien de Paris"
       Test NTF_Lambert_II_Etendu, NTF_Paris_Geo, 998137, 2413822, "6gr", "54gr", m, gr, 0
    Debug.Print vbTab & "+ NTF Lambert II étendu -> RGF Lambert 93"
       Test NTF_Lambert_II_Etendu, RGF93_Lambert_93, 998137, 2413822, "1049052m", "6843777m", m, m, 1
    Debug.Print vbTab & "+ RGF Lambert 93 -> NTF Lambert II étendu"
       Test RGF93_Lambert_93, NTF_Lambert_II_Etendu, 1049052, 6843777, " 998137m", "2413822m", m, m, 1
    Debug.Print vbTab & "+ BD72 Lambert 72 -> BD72"
       Test BD72_Lambert72, BD72_Geo, 235000, 45000, "5°32'45.48188''", "49°42'40.06796''", m, dms
    Debug.Print vbTab & "+ BD72 Lambert 72 -> ETRS89"
       Test BD72_Lambert72, ETRS89_Geo, 235000, 45000, "5°32'50.09529''", "49°42'37.96785''", m, dms
    Debug.Print vbTab & "+ ETRS Lambert 08 -> ETRS89"
       Test ETRS89_Lambert08, ETRS89_Geo, 735000, 545000, "5°32'49.39407", "49°42'37.60005", m, dms
    Debug.Print vbTab & "+ ETRS Lambert 08 -> BD72 Lambert 72"
       Test ETRS89_Lambert08, BD72_Lambert72, 735000, 545000, "234986.1", "44988.4", m, m, 1
    Debug.Print vbTab & "+ BD72 Lambert 72 -> ETRS Lambert 08"
       Test BD72_Lambert72, ETRS89_Lambert08, 50000, 200000, "549996.807", "699988.150", m, m, 1
    Debug.Print "---"
    End Sub
    Public Sub TestAlgos()
       Dim tProj As tProjection
       Dim tTrans As tTransformation
       Dim tXYZ As t_XYZ
       Dim dVal As Double
       Dim av(0 To 2) As Variant
       Dim i As Integer
       Dim sTabs As String
       sTabs = vbTab & vbTab
    Debug.Print "--- Validation des algorithmes ---"
       'utilisé par alg01 et 02
       av(0) = VBA.Array(1.00552653648, 0.08199188998, 0.872664626)
       av(1) = VBA.Array(-0.3026169006, 0.08199188998, -0.29999999997)
       av(2) = VBA.Array(0.2, 0.08199188998, 0.19998903369)
       'alg01
    Debug.Print vbTab & "+ alg01 - Latitude isométrique à partir de la latitude"
       For i = 0 To UBound(av)
    Debug.Print sTabs & "Attendu -> phi(rad) : " & av(i)(0)
    Debug.Print sTabs & "Obtenu  -> phi(rad) : " & alg01(av(i)(2), av(i)(1))
    Debug.Print sTabs & "---"
       Next i
       'alg02
    Debug.Print vbTab & "+ alg02 - Latitude à partir de la latitude isométrique"
       For i = 0 To UBound(av)
    Debug.Print sTabs & "Attendu -> Lat iso : " & av(i)(2)
    Debug.Print sTabs & "Obtenu  -> Lat iso : " & alg02(av(i)(0), av(i)(1))
    Debug.Print sTabs & "---"
       Next i
       'alg03
    Debug.Print vbTab & "+ alg03 - Coordonnées géo vers Lambert"
    Debug.Print sTabs & "Attendu -> X : " & 1029705.0818 & " m _ Y : " & 272723.851 & " m"
       With tProj
          .tEl.de = 0.0824832568
          .dN = 0.760405966
          .dc = 11603796.9767
          .dlambda0 = 0.04079234433
          .dXs = 600000
          .dYs = 5657616.674
       End With
       tXYZ = alg03(0.145512099, 0.872664626, tProj)
    Debug.Print sTabs & "Obtenu  -> X : " & Arrondi(tXYZ.dX, 4) & " m _ Y : " & Arrondi(tXYZ.dY, 4) & " m"
    Debug.Print sTabs & "---"
       'alg04
    Debug.Print vbTab & "+ alg04 - Lambert vers coordonnées géo "
    Debug.Print sTabs & "Attendu -> lon : " & 0.14551209925 & " _ lat : " & 0.87266462567
       With tProj
          .tEl.de = 0.0824832568
          .dN = 0.760405966
          .dc = 11603796.9767
          .dlambda0 = 0.04079234433
          .dXs = 600000
          .dYs = 5657616.674
       End With
       tXYZ = alg04(1029705.083, 272723.849, tProj)
    Debug.Print sTabs & "Obtenu  -> Lon : " & Arrondi(tXYZ.dX, 11) & " _ Lat : " & Arrondi(tXYZ.dY, 11)
    Debug.Print sTabs & "---"
       'alg21
    Debug.Print vbTab & "+ alg21 - Calcul grande Normale"
    Debug.Print sTabs & "Attendu -> N : " & 6393174.9755 & " m"
       dVal = alg21(0.977384381, 6378388, 0.08199189)
    Debug.Print sTabs & "Obtenu  -> N : " & Arrondi(dVal, 4) & " m"
    Debug.Print sTabs & "---"
       'alg09
    Debug.Print vbTab & "+ alg09 - Coordonnées géo vers cartésiennes"
    Debug.Print sTabs & "Attendu -> X : " & 6376064.6955 & _
              " m _ Y : " & 111294.623 & " m _ Z : " & 128984.725 & " m"
       With tProj.tEl
          .dh = 100
          .da = 6378249.2
          .de = 0.08248325679
       End With
       tXYZ = alg09(0.01745329248, 0.02036217457, tProj.tEl)
    Debug.Print sTabs & "Obtenu  -> X : " & Arrondi(tXYZ.dX, 4) & _
              " m _ Y : " & Arrondi(tXYZ.dY, 4) & " m _ Z : " & Arrondi(tXYZ.dZ, 4) & " m"
    Debug.Print sTabs & "---"
    Debug.Print sTabs & "Attendu -> X : " & 6378232.2149 & _
              " m _ Y : " & 18553.578 & " m _ Z : " & 0 & " m"
       With tProj.tEl
          .dh = 10
          .da = 6378249.2
          .de = 0.08248325679
       End With
       tXYZ = alg09(0.00290888212, 0, tProj.tEl)
    Debug.Print sTabs & "Obtenu  -> X : " & Arrondi(tXYZ.dX, 4) & _
              " m _ Y : " & Arrondi(tXYZ.dY, 4) & " m _ Z : " & Arrondi(tXYZ.dZ, 4) & " m"
    Debug.Print sTabs & "---"
       'alg12
    Debug.Print vbTab & "+ alg12 - Coordonnées cartésiennes vers géo"
    Debug.Print sTabs & "Attendu -> Lon : " & 0.01745329248 & _
              " _ Lat : " & 0.02036217457 & " _ h : " & 99.9995 & " m"
       With tProj.tEl
          .da = 6378249.2
          .de = 0.08248325679
       End With
       With tXYZ
          .dX = 6376064.695
          .dY = 111294.623
          .dZ = 128984.725
       End With
       tXYZ = alg12(tXYZ, tProj.tEl)
    Debug.Print sTabs & "Obtenu  -> Lon : " & Arrondi(tXYZ.dX, 11) & _
              " _ Lat : " & Arrondi(tXYZ.dY, 11) & " _ h : " & Arrondi(tXYZ.dZ, 4) & " m"
    Debug.Print sTabs & "---"
    Debug.Print sTabs & "Attendu -> Lon : " & 0.00581776423 & _
              " _ Lat : " & -0.03199770301 & " _ h : " & 2000.0001 & " m"
       With tXYZ
          .dX = 6376897.537
          .dY = 37099.705
          .dZ = -202730.907
       End With
       tXYZ = alg12(tXYZ, tProj.tEl)
    Debug.Print sTabs & "Obtenu  -> Lon : " & Arrondi(tXYZ.dX, 11) & _
              " _ Lat : " & Arrondi(tXYZ.dY, 11) & " _ h : " & Arrondi(tXYZ.dZ, 4) & " m"
    Debug.Print sTabs & "---"
       'alg13
    Debug.Print vbTab & "+ alg13 - Coordonnées cartésiennes vers cartésiennes"
    Debug.Print sTabs & "Attendu -> Vx : " & 4154005.8099 & _
              " m _ Vy : " & -80587.3284 & " m _ Vz : " & 4823289.5316 & " m"
       With tTrans
          .dTx = -69.4
          .dTy = 18
          .dTz = 452.2
          .dRx = 0
          .dRy = 0
          .dRz = 0.00000499358
          .dFacteurEchelle = 1 - 0.00000321
       End With
       With tXYZ
          .dX = 4154088.142
          .dY = -80626.331
          .dZ = 4822852.813
       End With
       tXYZ = alg13(tXYZ, tTrans)
    Debug.Print sTabs & "Obtenu  -> Vx : " & Arrondi(tXYZ.dX, 4) & _
              " m _ Vy : " & Arrondi(tXYZ.dY, 4) & " m _ Vz : " & Arrondi(tXYZ.dZ, 4) & " m"
    Debug.Print sTabs & "---"
       'alg54
    Debug.Print vbTab & "+ alg54 - Calcul paramètres lambert dans le cas sécant"
    Debug.Print sTabs & "Attendu -> c (m): " & 11565915.8294 & _
              " m _ n : " & 0.7716421867 & " _ Xs : " & 150000 & " _ Ys : " & 5400000
       With tProj
          .tEl.da = 6378388
          .tEl.de = 0.08199189
          .dlambda0 = 0.07623554539
          .dphi0 = 1.570796327
          .dXs = 0
          .dYs = 0
          .dphi1 = 0.869755744
          .dphi2 = 0.893026801
       End With
       alg54 tProj, 150000, 5400000
    Debug.Print sTabs & "Obtenu  -> c (m): " & tProj.dc & " m _ n : " & tProj.dN & _
              " _ Xs : " & tProj.dXs & " _ Ys : " & tProj.dYs
    Debug.Print sTabs & "---"
    Debug.Print sTabs & "Attendu -> c (m): " & -12453174.1795 & _
              " m _ n : " & -0.63049633 & " _ Xs : " & 0 & " _ Ys : " & -12453174.1795
       With tProj
          .tEl.da = 6378388
          .tEl.de = 0.08199189
          .dlambda0 = 0
          .dphi0 = 0
          .dXs = 0
          .dYs = 0
          .dphi1 = -0.575958653
          .dphi2 = -0.785398163
       End With
       alg54 tProj, 0, 0
    Debug.Print sTabs & "Obtenu  -> c (m): " & tProj.dc & " m _ n : " & tProj.dN & _
              " _ Xs : " & tProj.dXs & " _ Ys : " & tProj.dYs
    Debug.Print sTabs & "---"
    End Sub
    Private Sub Test(ByVal eDep As eSCG, ByVal eFin As eSCG, _
                     ByVal dXi As Double, dYi As Double, _
                     ByVal sXf As String, sYf As String, _
                     ByVal eUniteIn As eUnites, ByVal eUniteOut As eUnites, _
                     Optional ByVal byDecimal As Byte = 1)
       Dim tRes As tResults
       Dim sTabs As String
       sTabs = vbTab & vbTab
       Me.TypeConversion eDep, eFin
       If Me.IsErreur Then
    Debug.Print sTabs & "Erreur : " & Me.Erreur
       Else
          tRes = SetUnites(dXi, dYi, eUniteIn, True)
          With tRes
             Me.CalculSCG .dX, .dY
    Debug.Print sTabs & "Entrée  - Xi : " & .sX & " - Yi : " & .sY
    Debug.Print sTabs & "Attendu - Xf : " & sXf & " - Yf : " & sYf
             tRes = SetUnites(Me.X, Me.Y, eUniteOut, False, byDecimal)
    Debug.Print sTabs & "Obtenu  - Xc : " & .sX & " - Yc : " & .sY
          End With
       End If
    End Sub
    Private Function SetUnites(ByVal dX As Double, ByVal dY As Double, _
                               ByVal eUn As eUnites, ByVal bIn As Boolean, _
                               Optional ByVal byDecimal As Byte = 1) As tResults
       Dim tRes As tResults
       With tRes
          Select Case eUn
          Case eUnites.dms
             If bIn Then
                .dX = AngleDMSToRadian(dX)
                .dY = AngleDMSToRadian(dY)
                .sX = AngleDMSToString(dX, False)
                .sY = AngleDMSToString(dY, True)
             Else
                .sX = RadianToStringDMS(dX, False)
                .sY = RadianToStringDMS(dY, True)
             End If
          Case eUnites.gr
             If bIn Then
                .dX = GradeToRadian(dX)
                .dY = GradeToRadian(dY)
                .sX = dX & "gr"
                .sY = dY & "gr"
             Else
                .sX = Arrondi(RadianToGrade(dX), byDecimal) & "gr"
                .sY = Arrondi(RadianToGrade(dY), byDecimal) & "gr"
             End If
          Case eUnites.m
             If bIn Then
                .dX = dX
                .dY = dY
                .sX = dX & "m"
                .sY = dY & "m"
             Else
                .sX = Arrondi(dX, byDecimal) & "m"
                .sY = Arrondi(dY, byDecimal) & "m"
             End If
          Case eUnites.rad
             If bIn Then
                .dX = dX
                .dY = dY
                .sX = dX & "rad"
                .sY = dY & "rad"
             Else
                .sX = Arrondi(dX, byDecimal) & "rad"
                .sY = Arrondi(dY, byDecimal) & "rad"
             End If
          Case eUnites.DD
             If bIn Then
                .dX = DegreDecToRadian(dX)
                .dY = DegreDecToRadian(dY)
                .sX = dX & "°"
                .sY = dY & "°"
             Else
                .sX = Arrondi(RadianToDegreDec(dX), byDecimal) & "°"
                .sY = Arrondi(RadianToDegreDec(dY), byDecimal) & "°"
             End If
          End Select
       End With
       SetUnites = tRes
    End Function
    #End If
    Si vous avez des questions, problèmes, bugs, dites le moi sur ce thread.

    Philippe

  8. #8
    Membre du Club
    Homme Profil pro Pascal Boulesteix
    Inscrit en
    avril 2009
    Messages
    270
    Détails du profil
    Informations personnelles :
    Nom : Homme Pascal Boulesteix
    Localisation : France, Haute Vienne (Limousin)

    Informations forums :
    Inscription : avril 2009
    Messages : 270
    Points : 68
    Points
    68

    Par défaut A propos de votre classe de conversion

    Bonjour,
    Je découvre votre classe de conversion de coordonnées.
    Je me suis empressé de la même en action mais j'ai quelques problème.
    Le cas testé est le suivant :
    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    Dim oConv As oSCG
                  Set oConv = New oSCG
                  oConv.TypeConversion NTF_Lambert_II_Etendu, RGF93_Lambert_93
                  If Not oConv.IsErreur Then
                  X = 600000
                    Y = 2099966
                     oConv.CalculSCG X, Y
                     Debug.Print "Longitude : " & oConv.RadianToDegreDec(oConv.X)
                     Debug.Print "Latitude  : " & oConv.RadianToDegreDec(oConv.Y)
                  End If
                  Set oConv = Nothing
    le résultat est : Longitude : 37159780,2701259
    Latitude : 374346563,487844.
    Cela me semble bizarre car la conversion devrait donner environ X = 648560
    Y = 6533580
    Auriez-vous une explication ?
    Pascal

  9. #9
    Membre Expert

    Inscrit en
    avril 2006
    Messages
    1 390
    Détails du profil
    Informations forums :
    Inscription : avril 2006
    Messages : 1 390
    Points : 1 961
    Points
    1 961

    Par défaut

    bonjour,

    Vous faites une conversion de Lambert II Etendu vers du Lambert 93 dont l'unité est le mètre et non le radian.
    Il ne faut donc pas faire une conversion de radians vers degrés décimaux à la fin.

    Voici le code qui fonctionne :
    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
     
    Public Function testSCG()
       Dim oConv As oSCG
       Dim x As Long, y As Long
       Set oConv = New oSCG
       oConv.TypeConversion NTF_Lambert_II_Etendu, RGF93_Lambert_93
       If Not oConv.IsErreur Then
          x = 600000
          y = 2099966
          oConv.CalculSCG x, y
          Debug.Print "X (m) : " & Round(oConv.x, 1)
          Debug.Print "Y (m) : " & Round(oConv.y, 1)
       End If
       Set oConv = Nothing
    End Function
    Et on obtient après arrondi :
    Code :
    1
    2
    3
     
    X (m) : 648560,5
    Y (m) : 6533580,1
    Pour améliorer cette conversion entre Lambert II étendu et Lambert 93 il faut utiliser une grille publiée par l'IGN qui permet par interpolation bilinéaire d'obtenir une conversion précise au mm !

    Je termine bientôt cette méthode.

    Cordialement,

    Philippe

  10. #10
    Membre Expert

    Inscrit en
    avril 2006
    Messages
    1 390
    Détails du profil
    Informations forums :
    Inscription : avril 2006
    Messages : 1 390
    Points : 1 961
    Points
    1 961

    Par défaut

    bonjour,

    ci-joint la version 1.04 de la classe de conversion entre systèmes géodésiques.

    Quoi de neuf :

    • Ajout conversion par grille GR3DF97A (table : GR3DF97A) qui améliore la précision des conversions Lambert 93 <-> Lambert II étendu et inversement par interpolation bilinéaire
    • Possibilité d'activer ou non la grille
    • Ajout de nouveaux calculs (après conversion vers une projection) :
      • la convergence des méridiens (en radian)
      • L'altération linéaire (mm/km)
      • le facteur d'échelle
    • Ajout d'un module contenant des fonctions pour lancer les jeux de tests
    • Classe renommée clSCG


    Philippe

  11. #11
    Nouveau Membre du Club
    Inscrit en
    septembre 2007
    Messages
    123
    Détails du profil
    Informations forums :
    Inscription : septembre 2007
    Messages : 123
    Points : 31
    Points
    31

    Par défaut

    bonjour, je suis interressé par cet appli, mais je n'arrive pas à récupérer GéoFLA avec le lien cité. Quelqu'un peux t'il m'aider ?

  12. #12
    Membre Expert

    Inscrit en
    avril 2006
    Messages
    1 390
    Détails du profil
    Informations forums :
    Inscription : avril 2006
    Messages : 1 390
    Points : 1 961
    Points
    1 961

    Par défaut

    bonjour,

    je n'arrive pas à récupérer GéoFLA avec le lien cité
    il faut voir dans Espace professionnel -> Produits gratuits -> A télécharger
    Cliquer sur GEOFLA pour accéder aux téléchargements.

    cordialement,

    Philippe

  13. #13
    Nouveau Membre du Club
    Inscrit en
    septembre 2007
    Messages
    123
    Détails du profil
    Informations forums :
    Inscription : septembre 2007
    Messages : 123
    Points : 31
    Points
    31

    Par défaut

    Merci PhilBen,

    j'ai pu récupérer GéoFla et faire tourner cet appli.
    penses-tu qu'il serait possible à partir de cet appli, de faire un focus sur une ville pa exemple (Je rentre les coordonnées cardinales d'une ville et celle-ci s'affiche sur ma carte) ?

  14. #14
    Membre Expert

    Inscrit en
    avril 2006
    Messages
    1 390
    Détails du profil
    Informations forums :
    Inscription : avril 2006
    Messages : 1 390
    Points : 1 961
    Points
    1 961

    Par défaut

    bonjour,

    (Je rentre les coordonnées cardinales d'une ville et celle-ci s'affiche sur ma carte) ?
    Oui, sans problème, le programme le fait déjà pour les chefs-lieu grâce à leurs longitude et latitude (marquage par apparition d'un cercle).
    Il faut une base des villes françaises avec coordonnées GPS.

    Une autre solution est d'utiliser google map au lieu d'une image de la carte de France ce qui autorise plus de possiblités au niveau interface (zoom, type de carte,...).

    Philippe

Liens sociaux

Règles de messages

  • Vous ne pouvez pas créer de nouvelles discussions
  • Vous ne pouvez pas envoyer des réponses
  • Vous ne pouvez pas envoyer des pièces jointes
  • Vous ne pouvez pas modifier vos messages
  •