Conversion gps

Soyez le premier à donner votre avis sur cette source.

Vue 6 768 fois - Téléchargée 830 fois

Description

Ce petit logiciel permet de convertir des coordonnées sexadécimales en coordonnées décimales.
Par exemple 45°53'36" = 45,89°, il peut y avoir une due à l'arrondissement des décimales.
De même 121,135° = 121°08'06", ça marche dans les deux sens, mais ne pas oublier de vider les afficheurs pour faire une nouvelle mesure que vous pouvez valider avec la bouton "Conversion".

Codes Sources

A voir également

Ajouter un commentaire Commentaires
cs_Multiprise
Messages postés
63
Date d'inscription
jeudi 4 décembre 2003
Statut
Membre
Dernière intervention
23 avril 2013

14 févr. 2013 à 22:13
On a tous débuté un jour, et c'est grâce au partage et aux connaissances des autres qu'on a appri, en tous cas c'est vrai pour moi. Et ta démarche de partage même si tu es débutant, est tout a fait honorable, c'est ainsi qu'on avance.
Bonjour Multiprise,

c'est un très joli code, vraiment du bon travail, moi-même, je n'ai pas été capable de faire mieux, mais je débute.

Merci pour le partage.
cs_Multiprise
Messages postés
63
Date d'inscription
jeudi 4 décembre 2003
Statut
Membre
Dernière intervention
23 avril 2013

11 févr. 2013 à 09:38
Pour compléter, voici d'autres conversions possibles:
'-------------------------------------------------------------------------
'Convertion des minutes et secondes en fractions décimales de degré
'Conversion degrés en degrés décimaux
'---------------------------------------------------------------------------
Public Function Deg2Decim(ByVal DegresLiteral As String, Optional format As String = "dd°mm'ss.ss'' N-S-E-W") As Double
Dim Deg As Double
Dim Min As Double
Dim Sec As Double
Dim Orientation As String
Dim Coef As Integer
Dim i As Integer
Dim Multi As Integer
Dim tabTmp() As String
'Formulation générale Ex: latitude (degrés décimaux) = degrés + (minutes / 60) + (secondes / 3600)
'EX: 45° 53' 36" > 45 + (53 / 60) + (36 / 3600) = 45,893333...
Coef = 1
DegresLiteral = Trim(DegresLiteral)
If Right(DegresLiteral, 1) Like "N" Then
Orientation = "N"
DegresLiteral = Trim(Left(DegresLiteral, Len(DegresLiteral) - 1))
Coef = 1
ElseIf Right(DegresLiteral, 1) Like "S" Then
Orientation = "S"
DegresLiteral = Trim(Left(DegresLiteral, Len(DegresLiteral) - 1))
Coef = -1
ElseIf Right(DegresLiteral, 1) Like "E" Then
Orientation = "E"
DegresLiteral = Trim(Left(DegresLiteral, Len(DegresLiteral) - 1))
Coef = 1
ElseIf Right(DegresLiteral, 1) Like "W" Or Right(DegresLiteral, 1) Like "O" Then
Orientation = "W"
DegresLiteral = Trim(Left(DegresLiteral, Len(DegresLiteral) - 1))
Coef = -1
End If
If Left(DegresLiteral, 1) = "-" Then
DegresLiteral = Trim(Mid(DegresLiteral, 2))
Coef = -1
End If
If Left(DegresLiteral, 1) = "+" Then
DegresLiteral = Trim(Mid(DegresLiteral, 2))
Coef = 1
End If
DegresLiteral = Replace(DegresLiteral, "°", " ")
DegresLiteral = Replace(DegresLiteral, "d", " ", , , 1)
DegresLiteral = Replace(DegresLiteral, ",", " ")
DegresLiteral = Replace(DegresLiteral, "'", " ")
DegresLiteral = Replace(DegresLiteral, "m", " ", , , 1)
DegresLiteral = Replace(DegresLiteral, """", " ")
DegresLiteral = Replace(DegresLiteral, "s", " ", , , 1)
DegresLiteral = Replace(DegresLiteral, "''", " ", , , 1)
Do While InStr(1, DegresLiteral, " ") > 0
DegresLiteral = Replace(DegresLiteral, " ", " ")
Loop
tabTmp = Split(DegresLiteral, " ", , 1)Err.Clear: i -1: i UBound(tabTmp)
If i > -1 Then
Multi = LBound(tabTmp) If Multi 0 Then Multi 1
For i = LBound(tabTmp) To UBound(tabTmp)
If Multi = 1 Then
Deg2Decim = Deg2Decim + (Val(tabTmp(i)) * 1) ' + (Val(tabTmp(1)) / 60) + (Val(tabTmp(2)) / 3600)
ElseIf Multi = 2 Then
Deg2Decim = Deg2Decim + (Val(tabTmp(i)) / 60)
ElseIf Multi = 3 Then
Deg2Decim = Deg2Decim + (Val(tabTmp(i)) / 3600)
Else
Exit For
End If
Multi = Multi + 1
Next

Else
Deg2Decim = 0
End If
Deg2Decim = Round(Coef * Deg2Decim, 8)
End Function
'-------------------------------------------------------------------------
'Conversion des degrés décimaux en degres, minutes, secondes.centiemes
' dd.dddd => dd°mm'ss.ss''
'---------------------------------------------------------------------------
Public Function DegDecim2DegMinSec(ByVal DegresDecim As String, Optional FormatEntree As String = "dd.dddd°") As String

Dim Deg As Double
Dim Min As Double
Dim Sec As Double
Dim i As Integer
Dim reste As Double
Dim iCardinal As Integer
On Error Resume Next
'
' Exemple : soit une longitude de 121,135°
' 1.Le nombre avant la virgule indique les degrés ? 121°
' 2.Multiplier le nombre après la virgule par 60 ? 0,135 * 60 = 8,1
' 3.Le nombre avant la virgule devient la minute (8')
' 4.Multiplier le nombre après la virgule par 60 ? 0,1 * 60 = 6
' 5.Le résultat correspond aux secondes (6").
' 6.Notre longitude sera de 121° 8' 6"
DegresDecim = Trim(DegresDecim)
DegresDecim = Replace(Replace(Replace(DegresDecim, "'", " "), "°", " "), "d", "", , , 1)
'suppression doubles espaces
Do While InStr(1, DegresDecim, " ") > 0
DegresDecim = Replace(DegresDecim, " ", " ")
Loop
If Left(DegresDecim, 1) = "-" Or Left(DegresDecim, 1) Like "S" Or Left(DegresDecim, 1) Like "O" Or Left(DegresDecim, 1) Like "W" Then
iCardinal = -1
DegresDecim = Trim(Mid(DegresDecim, 2))
End If
If Left(DegresDecim, 1) = "+" Or Left(DegresDecim, 1) Like "N" Or Left(DegresDecim, 1) Like "E" Then
iCardinal = 1
DegresDecim = Trim(Mid(DegresDecim, 2))
End If
If Right(DegresDecim, 1) Like "E" Or Right(DegresDecim, 1) Like "N" Then
iCardinal = 1
DegresDecim = Trim(Mid(DegresDecim, 1, Len(DegresDecim) - 1))
End If
If Right(DegresDecim, 1) Like "O" Or Right(DegresDecim, 1) Like "W" Or Right(DegresDecim, 1) Like "S" Then
iCardinal = -1
DegresDecim = Trim(Mid(DegresDecim, 1, Len(DegresDecim) - 1))
End If
DegresDecim = Abs(CDbl(DegresDecim))
Deg = Int(CDbl(DegresDecim))
reste = Round(CDbl(DegresDecim) - Deg, 12)
Min = Int(reste * 60)
reste = Round((reste * 60) - Min, 12)
Sec = Int(reste * 60)
reste = Round((reste * 60) - Int(reste * 60), 12)
'
DegDecim2DegMinSec = format(Deg, "000") & "°" & format(Min, "00") & "'" & Sec + Round(reste, 2) & "''"If iCardinal -1 Then DegDecim2DegMinSec "-" & DegDecim2DegMinSec
End Function

'-------------------------------------------------------------------------
'Conversion des degres, minutes, secondes.centiemes en Degres Decimaux
' dd°mm'ss.ss'' => dd.dddddd°
'---------------------------------------------------------------------------
Public Function DegMinSec2DegDecim(ByVal DegMinSec As String, Optional FormatEntree As String = "dd°mm'ss.ss''") As String

Dim Deg As Double
Dim Min As Double
Dim Sec As Double
Dim i As Integer
Dim reste As Double
Dim ttmp() As String
Dim iCardinal As Integer
'
iCardinal = 1
DegMinSec = Trim(DegMinSec)
If Left(DegMinSec, 1) = "-" Or Left(DegMinSec, 1) Like "S" Or Left(DegMinSec, 1) Like "O" Or Left(DegMinSec, 1) Like "W" Then
iCardinal = -1
DegMinSec = Trim(Mid(DegMinSec, 2))
End If
If Left(DegMinSec, 1) = "+" Or Left(DegMinSec, 1) Like "N" Or Left(DegMinSec, 1) Like "E" Then
iCardinal = 1
DegMinSec = Trim(Mid(DegMinSec, 2))
End If
If Right(DegMinSec, 1) Like "E" Or Right(DegMinSec, 1) Like "N" Then
iCardinal = 1
DegMinSec = Trim(Mid(DegMinSec, 1, Len(DegMinSec) - 1))
End If
If Right(DegMinSec, 1) Like "O" Or Right(DegMinSec, 1) Like "W" Or Right(DegMinSec, 1) Like "S" Then
iCardinal = -1
DegMinSec = Trim(Mid(DegMinSec, 1, Len(DegMinSec) - 1))
End If
DegMinSec = Replace(Replace(Replace(Replace(Replace(Replace(DegMinSec, "'", " "), " ", " "), "°", " "), "m", " ", , , 1), "d", " ", , , 1), "s", " ", , , 1)
'suppression doubles espaces
Do While InStr(1, DegMinSec, " ") > 0
DegMinSec = Replace(DegMinSec, " ", " ")
Loop

ttmp = Split(DegMinSec, " ")
Deg = Val(ttmp(0))
Min = Round(CDbl(ttmp(1)) / 60, 12)
Sec = Round(CDbl(ttmp(2)) / 3600, 12)
'
DegMinSec2DegDecim = format(Round(Deg + Min + Sec, 8) * iCardinal, "000.00000000")
End Function

'-------------------------------------------------------------------------
'Conversion des degrés avec Minutes décimales en degres, minutes, secondes.centiemes
'DD°MM.mmmm' > DD°MM'SS.ss''
'---------------------------------------------------------------------------
Public Function DegMinDecim2DegMinSec(ByVal DegMinDecim As String, Optional FormatEntree As String = "DD°MM.mmmm") As String

Dim Deg As Double
Dim Min As Double
Dim Sec As Double
Dim i As Integer
Dim reste As Double
Dim tabTmp() As String
Dim iCardinal As Integer
'Exemple : soit une longitude de 1°21.135 ou 1 21.135
' 1.Le Premier Groupe de Nombre Indique les Degres (1°)
' 2.Le second Groupe de nombre indique les minutes décimales
' 3.La partie entiere represente les Minutes (21')
' 4.Multiplier la Partie décimale par 60 ? 0,135 * 60 = 8,1
' 5.Le résultat correspond aux secondes (8.1").
' 6.Notre longitude sera de 1° 21' 8.1''"
iCardinal = 1
DegMinDecim = Trim(DegMinDecim)
If Left(DegMinDecim, 1) = "-" Or Left(DegMinDecim, 1) Like "S" Or Left(DegMinDecim, 1) Like "O" Or Left(DegMinDecim, 1) Like "W" Then
iCardinal = -1
DegMinDecim = Mid(DegMinDecim, 2)
ElseIf Left(DegMinDecim, 1) = "+" Or Left(DegMinDecim, 1) Like "N" Or Left(DegMinDecim, 1) Like "E" Then
iCardinal = 1
DegMinDecim = Mid(DegMinDecim, 2)
ElseIf Right(DegMinDecim, 1) Like "E" Or Right(DegMinDecim, 1) Like "N" Then
iCardinal = 1
DegMinDecim = Mid(DegMinDecim, 1, Len(DegMinDecim) - 1)
ElseIf Right(DegMinDecim, 1) Like "O" Or Right(DegMinDecim, 1) Like "W" Or Right(DegMinDecim, 1) Like "S" Then
iCardinal = -1
DegMinDecim = Mid(DegMinDecim, 1, Len(DegMinDecim) - 1)
End If
DegMinDecim = Replace(Trim(DegMinDecim), "°", " ", , , 1)
DegMinDecim = Replace(Trim(DegMinDecim), ",", " ", , , 1)
'supprimer les espaces doubles
Do While InStr(1, DegMinDecim, " ") > 0
DegMinDecim = Replace(DegMinDecim, " ", " ")
Loop
'Reconstruire la valeur en DD°MM'SS.ss''
tabTmp = Split(DegMinDecim, " ", , 1)
Deg = format(Val(tabTmp(0)), "000")
Min = format(Int(Val(tabTmp(1))), "00")
Sec = CStr(Round(((Val(tabTmp(1)) - Val(Min)) * 60), 2))
'
DegMinDecim2DegMinSec = Deg & "°" & Min & "'" & Sec & "''"If iCardinal -1 Then DegMinDecim2DegMinSec "-" & DegMinDecim2DegMinSec
End Function

'-------------------------------------------------------------------------
'Conversion des degrés avec Minutes décimales en degres décimaux
'DD°MM.mmmm' > DD.dddddd°
'---------------------------------------------------------------------------

Public Function DegMinDecim2DegDecim(ByVal DegMinDecim As String, Optional FormatEntree As String = "DD°MM.mmmm") As String
Dim Deg As Double
Dim Min As Double
Dim Sec As Double
Dim i As Integer
Dim reste As Double
Dim tabTmp() As String
Dim iCardinal As Integer
'Exemple : soit une longitude de 1°21.135 ou 1 21.135
' 1.Le Premier Groupe de Nombre Indique les Degres (1°)
' 2.Le second Groupe de nombre indique les minutes décimales
' 3.Diviser les minutes décimales par 60 => 21,135 / 60 = 0.35225
' 4.Ajouter aux degrés => 1+0.35225 =1.35225
' 5.Notre longitude sera de 1.35225°
iCardinal = 1
DegMinDecim = Trim(DegMinDecim)
If Left(DegMinDecim, 1) = "-" Or Left(DegMinDecim, 1) Like "S" Or Left(DegMinDecim, 1) Like "O" Or Left(DegMinDecim, 1) Like "W" Then
iCardinal = -1
DegMinDecim = Mid(DegMinDecim, 2)
ElseIf Left(DegMinDecim, 1) = "+" Or Left(DegMinDecim, 1) Like "N" Or Left(DegMinDecim, 1) Like "E" Then
iCardinal = 1
DegMinDecim = Mid(DegMinDecim, 2)
ElseIf Right(DegMinDecim, 1) Like "E" Or Right(DegMinDecim, 1) Like "N" Then
iCardinal = 1
DegMinDecim = Mid(DegMinDecim, 1, Len(DegMinDecim) - 1)
ElseIf Right(DegMinDecim, 1) Like "O" Or Right(DegMinDecim, 1) Like "W" Or Right(DegMinDecim, 1) Like "S" Then
iCardinal = -1
DegMinDecim = Mid(DegMinDecim, 1, Len(DegMinDecim) - 1)
End If
DegMinDecim = Replace(Trim(DegMinDecim), "°", " ", , , 1)
DegMinDecim = Replace(Trim(DegMinDecim), ",", " ", , , 1)
'supprimer les espaces doubles
Do While InStr(1, DegMinDecim, " ") > 0
DegMinDecim = Replace(DegMinDecim, " ", " ")
Loop
'Reconstruire la valeur en DD.dddddd°
tabTmp = Split(DegMinDecim, " ", , 1)
Deg = Val(tabTmp(0))
Min = Val(tabTmp(1)) / 60
'
DegMinDecim2DegDecim = format(Round(Deg + Min, 8), "000.00000000") & "°"If iCardinal -1 Then DegMinDecim2DegDecim "-" & DegMinDecim2DegDecim
End Function

'-------------------------------------------------------------------------
'Conversion des degrés décimaux en degrés avec Minutes décimales
'DD.dddd' > DD°MM.mmmm''
'---------------------------------------------------------------------------
Public Function DegDecim2DegMinDecim(ByVal DegDecim As String, Optional FormatEntree As String = "DD.dddd") As String

Dim Deg As Double
Dim Min As Double
Dim Sec As Double
Dim i As Integer
Dim reste As Double
Dim tabTmp() As String
Dim iCardinal As Integer
On Error Resume Next
'Exemple : soit une longitude de 1.595°
' 1.Le Premier Groupe de Nombre Indique les Degres entiers (1°)
' 2.Le second Groupe de nombre indique les degrés décimaux (0.595)
' 4.Multiplier la Partie décimale par 60 ? 0.595 * 60 = 35.7000
' 5.Le résultat correspond aux minutes décimales (35.7000').
' 6.Notre longitude sera de 1°35.7000' "
iCardinal = 1
DegDecim = Trim(DegDecim)
If Left(DegDecim, 1) = "-" Or Left(DegDecim, 1) Like "S" Or Left(DegDecim, 1) Like "O" Or Left(DegDecim, 1) Like "W" Then
iCardinal = -1
DegDecim = Mid(DegDecim, 2)
ElseIf Left(DegDecim, 1) = "+" Or Left(DegDecim, 1) Like "N" Or Left(DegDecim, 1) Like "E" Then
iCardinal = 1
DegDecim = Mid(DegDecim, 2)
ElseIf Right(DegDecim, 1) Like "E" Or Right(DegDecim, 1) Like "N" Then
iCardinal = 1
DegDecim = Mid(DegDecim, 1, Len(DegDecim) - 1)
ElseIf Right(DegDecim, 1) Like "O" Or Right(DegDecim, 1) Like "W" Or Right(DegDecim, 1) Like "S" Then
iCardinal = -1
DegDecim = Mid(DegDecim, 1, Len(DegDecim) - 1)
End If
DegDecim = Abs(CDbl(Trim(DegDecim)))
'Reconstruire la valeur en DD°MM'SS.ss''
Deg = Int(CDbl(DegDecim))
Min = Round((CDbl(DegDecim) - Deg) * 60, 12)
'
DegDecim2DegMinDecim = format(Deg, "00") & "°" & format(Min, "00.00000000")If iCardinal -1 Then DegDecim2DegMinDecim "-" & DegDecim2DegMinDecim
End Function

'-------------------------------------------------------------------------
'Conversion des degres, minutes, secondes.centiemes en Degres et Minutes décimales
' dd°mm'ss.ss'' => dd°mm.mmmmmm'
'---------------------------------------------------------------------------
Public Function DegMinSec2DegMinDecim(ByVal DegMinSec As String, Optional FormatEntree As String = "dd°mm'ss.ss''") As String

Dim Deg As Double
Dim Min As Double
Dim Sec As Double
Dim i As Integer
Dim reste As Double
Dim ttmp() As String
Dim iCardinal As Integer
'
iCardinal = 1
DegMinSec = Trim(DegMinSec)
DegMinSec = Replace(Replace(DegMinSec, "°", " "), "d", " ")
'suppression doubles espaces
Do While InStr(1, DegMinSec, " ") > 0
DegMinSec = Replace(DegMinSec, " ", " ")
Loop
DegMinSec = Replace(Replace(DegMinSec, "'", " "), " ", " ")
If Left(DegMinSec, 1) = "-" Or Left(DegMinSec, 1) Like "S" Or Left(DegMinSec, 1) Like "O" Or Left(DegMinSec, 1) Like "W" Then
iCardinal = -1
DegMinSec = Trim(Mid(DegMinSec, 2))
End If
If Left(DegMinSec, 1) = "+" Or Left(DegMinSec, 1) Like "N" Or Left(DegMinSec, 1) Like "E" Then
iCardinal = 1
DegMinSec = Trim(Mid(DegMinSec, 2))
End If
If Right(DegMinSec, 1) Like "E" Or Right(DegMinSec, 1) Like "N" Then
iCardinal = 1
DegMinSec = Trim(Mid(DegMinSec, 1, Len(DegMinSec) - 1))
End If
If Right(DegMinSec, 1) Like "O" Or Right(DegMinSec, 1) Like "W" Or Right(DegMinSec, 1) Like "S" Then
iCardinal = -1
DegMinSec = Trim(Mid(DegMinSec, 1, Len(DegMinSec) - 1))
End If
ttmp = Split(DegMinSec, " ")
Deg = Val(ttmp(0))
Min = Round(CDbl(ttmp(1)), 12)
Sec = Round(CDbl(ttmp(2)) / 60, 12)
'
DegMinSec2DegMinDecim = format(Deg * iCardinal, "00") & "°" & format(Round(Min + Sec, 8), "00.00000000") & "'"
End Function
cs_JLN
Messages postés
371
Date d'inscription
samedi 1 juin 2002
Statut
Membre
Dernière intervention
17 juin 2013

10 févr. 2013 à 09:35
Attention, je connais au moins 2 type de coordonnées GPS les Lambert et les géodésiques il y en a peut-être d'autres...

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.