#31 Mon 19 November 2007 10:52
- gigilogi
- Participant occasionnel
- Date d'inscription: 16 Nov 2007
- Messages: 14
Re: Transformations affines et corrections d'Helmert
ne sachant pas si le message est passé ?
merci pour tes conseils avisés et aussi pour ta patience christophe.
à +
Hors ligne
#33 Mon 19 November 2007 18:38
- gigilogi
- Participant occasionnel
- Date d'inscription: 16 Nov 2007
- Messages: 14
Re: Transformations affines et corrections d'Helmert
pardon
je rectifie mes erreurs for i ..............next i
sachant que pointx(i) et pointy(i) est l'image de repd.
il suffit d' afficher les nouveaux points pointtransformex(i%) et pointtransformey(i%) avec les textes des coordonnées de
pointx(i) et pointy(i)
redim pointx(1 to maxpoint -1)
redim pointy(1 to maxpoint -1)
dim pointtransformex(1 to maxpoint -1)
dim pointtransformey(1 to maxpoint -1)
for i%= 0 to maxpoint -1
pointtransformex(i%+1)=param(0)*pointx(i%+1)+param(1)*pointy(i%+1)+param(2)
pointtransformey(i%+1)=-param(1)*pointx(i%+1)+param(0)*pointy(i%+1)+param(3)
next i%
j' ai essayé le code que tu m' as gracieusement donné (même si j'ai pas tout compris sur la méthode du pivot de gauss)
ton code marche nickel chrome.
merci encore christophe.
Hors ligne
#34 Mon 19 November 2007 21:14
- ChristopheV
- Membre
- Lieu: Ajaccio
- Date d'inscription: 7 Sep 2005
- Messages: 3175
- Site web
Re: Transformations affines et corrections d'Helmert
Bonjour,
De rien, peut-être peux tu nous faire un résumé de tout ça pour ceux qui viendront consulter a posteriori (ce sera ta géo contribution)?
Ben, christian t'as voulu dire quoi ?? ( Pour les formules je pense pas à la contestation t'as les mêmes cours que moi non ?)
Mais une version C/C++ de l'algo c'est bon dans les archives (C je prends volontier, ça permet de faire une dll "callable" depuis VB6)
A+
Christophe
Christophe
L'avantage d'être une île c'est d'être une terre topologiquement close
Hors ligne
#35 Tue 20 November 2007 20:02
- gigilogi
- Participant occasionnel
- Date d'inscription: 16 Nov 2007
- Messages: 14
Re: Transformations affines et corrections d'Helmert
salut christophe
je suis d'accord pour faire un résumé mais je ne suis pas sûr d'être le mieux placé pour le faire vu que c'est toi qui m' a tout apporté
ce serait vraiment prétentieux de ma part.
de plus il ya encore pas mal de chose qui m'échappe , je t'explique (un exemple valant mieux que de longs discours):
j' ai une parcelle sur le scan ,pour essai j' ai créé un fichier dxf correspondant aux points de cette parcelle en la cliquant en différents points
sur la picture du scan et en enregistrant le fichier des points.
ensuite j'ouvre le fichier texte de ce dxf et je multiplie toutes les coordonnées des points par 10 pour se mettre dans les conditions les plus
défavorisantes et j'enregistre le fichier.
donc quand je rouvre le dxf sur la picture du scan je ne vois plus de points s' afficher (jusque la c'est normal puisque le coeff est * 10).
je clique donc le nombre de points sur la parcelle et je lance la transfo d' HELMERT -> Les points transformés s' affichent bien et la parcelle
constituée de ces points transformés est parfaitement dessinée si j' ai cliqué a peu près les mêmes points que ceux contenus dans le dxf.
par contre si je loupe un point en cliquant sur le scan (point trop décalé ou mal positionné )-> catastrophe ,la parcelle constituée des points transformés est décalée elle aussi ??
il faut donc cliquer les mêmes points sur le scan que ceux contenus dans le dxf ???
Hors ligne
#36 Tue 20 November 2007 20:42
- gigilogi
- Participant occasionnel
- Date d'inscription: 16 Nov 2007
- Messages: 14
Re: Transformations affines et corrections d'Helmert
salut christophe
et autre problème -> si la parcelle contenue dans le dxf n' a pas le même angle de rotation (que ce soit en + ou -) que la parcelle du scan
la transformation d'helmert ne marche pas ???
la parcelle redessinée reste la même ????
Hors ligne
#37 Wed 21 November 2007 17:24
- gigilogi
- Participant occasionnel
- Date d'inscription: 16 Nov 2007
- Messages: 14
Re: Transformations affines et corrections d'Helmert
Code de l'application pour une première ébauche , je t'envoie le projet en VB par MAIL ,si tu as le temps de regarder :
Code:
Option Explicit Dim zoom As Integer Dim reponse As String Dim nombredepointsdxf As Integer Dim nombredepointsSystèmeArrivée As Integer Dim ChoisirPointsSystèmeArrivée As Integer 'déclarations des tableaux de points 'POINTS DU DXF Dim pointDXFx(1 To 2000) Dim pointDXFy(1 To 2000) 'points cliqués sur le SCAN Dim pointSCANx(1 To 2000) Dim pointSCANy(1 To 2000) 'points transformés Dim pointtransformex(1 To 2000) Dim pointtransformey(1 To 2000) Dim pointx(1 To 2000) Dim pointy(1 To 2000) Dim i As Integer Dim j As Integer Dim k As Integer Dim l As Integer Private Sub Form_Load() zoom = 1 nombredepointsdxf = 0 i = 1 nombredepointsSystèmeArrivée = 0 ChoisirPointsSystèmeArrivée = 0 End Sub '*****************************************************TRANSFORMATION D'HELMERT*****************************************************************' Private Sub Ouvrir_Fichier_Points_DXF_Click() 'on efface les points sur la pictureBox picdest PicDEST.Cls '******************************************************************************************************************' 'LE PRINCIPE d'un fichier DXF de points quand on l'ouvre avec WORDPAD OU LE BLOCNOTE : 'ACDbPoint '10 '1.1646 ------------> correspond à la coordonnées X1 '10 '6.5155 ------------> correspond à la coordonnées Y1 'etc.... 'ACDbPoint '10 '1.1646 ------------> correspond à la coordonnées X2 '10 '6.5155 ------------> correspond à la coordonnées Y2 'etc.... 'ACDbPoint '10 '5.2223 ------------> correspond à la coordonnées Xn '10 '10.3256 ------------> correspond à la coordonnées Yn '******************************************************************************************************************' 'le pincipe : on va lire tout le fichier et on s'arrête quand on a la valeur ACDbPoint 'on prends alors la 2ème ligne et la 4ème ligne après ACDbPoint qui correspondent 'aux coordonnées X1 et Y1 du premier point et ainsi de suite jusqu'au point Xn et Yn' '******************************************************************************************************************' dlgCommonDialog.CancelError = True On Error GoTo ErrHandler dlgCommonDialog.Flags = cdlOFNHideReadOnly dlgCommonDialog.Filter = "Texte(*.txt)|*.txt" dlgCommonDialog.ShowOpen Open dlgCommonDialog.FileName For Input As #1 Dim MyString i = 1 nombredepointsdxf = 0 Do While Not EOF(1) ' Effectue la boucle jusqu'à la fin du fichier. Input #1, MyString If MyString = "ACDbPoint" Then 'on sait qu'il y a un point de défini dans le DXF 'on veut aller lire la 2ème ligne et la 4ème ligne après ACDbPoint' Input #1, MyString 'on passe une ligne' Input #1, MyString 'on est sur la 2ème ligne après ACDbPoint' pointDXFx(i) = MyString 'on charge donc la coordonnée X1 dans le tableau' Input #1, MyString 'on passe une ligne' Input #1, MyString 'on est sur la 4ème ligne après ACDbPoint' pointDXFy(i) = MyString 'on charge donc la coordonnée Y1 dans le tableau' End If i = i + 1 'on incrémente le nombre de points contenus dans le fichier' nombredepointsdxf = nombredepointsdxf + 1 If nombredepointsdxf = 0 Then 'on ne créé pas de texte Else 'au préalable : tous les textes ou label doivent exister et être d'indice 0 (TxtDXFX(0),TxtDXFY(0),LblpointDXF(0)) 'on crée le nombre de texte et de label selon le nombre de points contenus dans le dxf Dim iNewItem As Integer 'Trouver l'index à créer iNewItem = TxtDXFX.UBound + 1 'Créer le nouveau contôle TxtDXFX et le positionner Load TxtDXFX(iNewItem) TxtDXFX(iNewItem).Top = TxtDXFX(iNewItem - 1).Top + TxtDXFX(iNewItem - 1).Height TxtDXFX(iNewItem).Left = TxtDXFX(iNewItem - 1).Left TxtDXFX(iNewItem).Visible = True TxtDXFX(iNewItem).Text = pointDXFx(iNewItem) Dim jNewItem As Integer 'Trouver l'index à créer jNewItem = TxtDXFY.UBound + 1 'Créer le nouveau contôle TxtDXFY et le positionner Load TxtDXFY(jNewItem) TxtDXFY(jNewItem).Top = TxtDXFY(jNewItem - 1).Top + TxtDXFY(jNewItem - 1).Height TxtDXFY(jNewItem).Left = TxtDXFY(jNewItem - 1).Left TxtDXFY(jNewItem).Visible = True TxtDXFY(jNewItem).Text = pointDXFy(jNewItem) Dim kNewItem As Integer 'Trouver l'index à créer kNewItem = LblpointDXF.UBound + 1 'Créer le nouveau contôle LblpointDXF et le positionner Load LblpointDXF(kNewItem) LblpointDXF(kNewItem).Top = LblpointDXF(kNewItem - 1).Top + LblpointDXF(kNewItem - 1).Height LblpointDXF(kNewItem).Left = LblpointDXF(kNewItem - 1).Left LblpointDXF(kNewItem).Caption = "Point" & kNewItem & ":" LblpointDXF(kNewItem).Visible = True End If 'on affiche le nombre de points contenus dans le dxf dans le texte suivant TxtnombredepointsDXF.Text = i - 1 Loop Close #1 ' Ferme le fichier. 'on appelle la fonction qui va dessiner les points sur la pictureBOX Call AFFICHERPOINTSDUDXFSURPICTURE 'une fois le fichier ouvert on peut demander à l' utilisateur de choisir les coordonnées du système d'arrivée '********************************************************************************************************************************' reponse = MsgBox("les Points du fichier DXF sont chargés (il peuvent être non visibles ),Veuillez Choisir les Points du Système d'Arrivée en les Cliquant consécutivement sur le Plan Scanné", vbYesNo) '********************************************************************************************************************************' If reponse = vbYes Then '********************************************************************************************************************************' 'l'utilisateur doit maintenant cliquer le même nombre de points sur la picturebox 'pour charger les points -> Private Sub Picdest_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) '********************************************************************************************************************************' 'on initialise le nombredepointsSystèmeArrivée nombredepointsSystèmeArrivée = 0 'on reset le nombre de points TxtnombredepointsSCAN.Text = 0 ChoisirPointsSystèmeArrivée = 1 'la frame nous permet d'afficher tous les points du dxf dans des textes,d'afficher tout les points cliqués sur le scan,d'afficher 'tout les points transformés et les paramètres a,b,p,q de la transformation d'helmert frmChoisirPointsSystèmeArrivée.Top = 0 frmChoisirPointsSystèmeArrivée.Left = 0 frmChoisirPointsSystèmeArrivée.Visible = True End If If reponse = vbNo Then ChoisirPointsSystèmeArrivée = 0 frmChoisirPointsSystèmeArrivée.Visible = False End If CBLANCERCALCULHELMERT.Visible = True ErrHandler: Exit Sub End Sub Private Sub Picdest_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If ChoisirPointsSystèmeArrivée = 1 Then 'nota :nombredepointsSystèmeArrivée est à 0 au démarrage nombredepointsSystèmeArrivée = nombredepointsSystèmeArrivée + 1 'au préalable : tous les textes ou label doivent exister et être d'indice 0 (Txtscanx(0),Txtscany(0),Lblpointscan(0)) 'on crée le nombre de texte et de label selon le nombre de points qu'on va cliquer sur le scan contenue dans la pictureBOX Picdest Dim iNewItem As Integer 'Trouver l'index à créer iNewItem = Txtscanx.UBound + 1 'Créer le nouveau contôle Txtscanx et le positionner Load Txtscanx(iNewItem) Txtscanx(iNewItem).Top = Txtscanx(iNewItem - 1).Top + Txtscanx(iNewItem - 1).Height Txtscanx(iNewItem).Left = Txtscanx(iNewItem - 1).Left Txtscanx(iNewItem).Visible = True Dim jNewItem As Integer 'Trouver l'index à créer jNewItem = Txtscany.UBound + 1 'Créer le nouveau contôle Txtscany et le positionner Load Txtscany(jNewItem) Txtscany(jNewItem).Top = Txtscany(jNewItem - 1).Top + Txtscany(jNewItem - 1).Height Txtscany(jNewItem).Left = Txtscany(jNewItem - 1).Left Txtscany(jNewItem).Visible = True Dim kNewItem As Integer 'Trouver l'index à créer kNewItem = Lblpointscan.UBound + 1 'Créer le nouveau contôle Lblpointscan et le positionner Load Lblpointscan(kNewItem) Lblpointscan(kNewItem).Top = Lblpointscan(kNewItem - 1).Top + Lblpointscan(kNewItem - 1).Height Lblpointscan(kNewItem).Left = Lblpointscan(kNewItem - 1).Left Lblpointscan(kNewItem).Caption = "Point" & kNewItem & ":" Lblpointscan(kNewItem).Visible = True 'on affiche le nombre de points cliqués sur le scan dans le texte suivant TxtnombredepointsSCAN.Text = nombredepointsSystèmeArrivée 'on charge les coordonnées des points cliqués sur le scan et on les affichent dans les textes sur la frame frmChoisirPointsSystèmeArrivée Txtscanx(nombredepointsSystèmeArrivée).Text = X / zoom Txtscany(nombredepointsSystèmeArrivée).Text = Y / zoom 'on charge les coordonnées des points cliqués sur le scan dans les tableaux pointSCANx(nombredepointsSystèmeArrivée) = X / zoom pointSCANy(nombredepointsSystèmeArrivée) = Y / zoom '***************************************************************************************************************************' 'on affiche ces points cliqués sur le scan en appelant la procédure Call AFFICHERPOINTSDUSYSTEMEARRIVEESURPICTURE '***************************************************************************************************************************' If nombredepointsSystèmeArrivée = nombredepointsdxf Then CBLANCERCALCULHELMERT.Visible = True MsgBox "vous pouvez lancer la transformation d'HELMERT" End If End If End Sub Private Sub Picdest_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) TextPICDESTX.Text = X / zoom TextPICDESTY.Text = Y / zoom TextPICDESTXREEL = X TextPICDESTYREEL = Y End Sub Sub AFFICHERPOINTSDUSYSTEMEARRIVEESURPICTURE() 'on dessine les points cliqués sur le scan en vert PicDEST.PSet (pointSCANx(nombredepointsSystèmeArrivée) * zoom, pointSCANy(nombredepointsSystèmeArrivée) * zoom), QBColor(4) 'on dessine les repères verticaux et horizontaux des points PicDEST.Line (pointSCANx(nombredepointsSystèmeArrivée) * zoom, pointSCANy(nombredepointsSystèmeArrivée) * zoom - 4)-(pointSCANx(nombredepointsSystèmeArrivée) * zoom, pointSCANy(nombredepointsSystèmeArrivée) * zoom + 4), RGB(0, 255, 0) PicDEST.Line (pointSCANx(nombredepointsSystèmeArrivée) * zoom - 4, pointSCANy(nombredepointsSystèmeArrivée) * zoom)-(pointSCANx(nombredepointsSystèmeArrivée) * zoom + 4, pointSCANy(nombredepointsSystèmeArrivée) * zoom), RGB(0, 255, 0) 'Call AFFICHERVALEURSDESPOINTS End Sub Sub AFFICHERPOINTSDUDXFSURPICTURE() 'fonction qui va dessiner les points sur la pictureBOX i = 1 For i = 1 To nombredepointsdxf 'on dessine les points PicDEST.PSet (pointDXFx(i) * zoom, pointDXFy(i) * zoom), QBColor(4) 'on dessine les repères verticaux et horizontaux des points PicDEST.Line (pointDXFx(i) * zoom, pointDXFy(i) * zoom - 4)-(pointDXFx(i) * zoom, pointDXFy(i) * zoom + 4), RGB(0, 0, 255) PicDEST.Line (pointDXFx(i) * zoom - 4, pointDXFy(i) * zoom)-(pointDXFx(i) * zoom + 4, pointDXFy(i) * zoom), RGB(0, 0, 255) Next i 'on appelle la fonction qui va afficher les valeurs des points sur la pictureBOX Call AFFICHERVALEURSDESPOINTS End Sub Sub AFFICHERVALEURSDESPOINTS() 'fonction qui va afficher les valeurs des points sur la pictureBOX PicDEST.ForeColor = vbRed For i = 1 To nombredepointsdxf 'affichage des textes des coordonnées X' PicDEST.CurrentX = pointDXFx(i) + 8 PicDEST.CurrentY = pointDXFy(i) - 8 PicDEST.Print "X" & i & "=" & pointDXFx(i) Next i 'affichage des textes des coordonnées Y' For i = 1 To nombredepointsdxf PicDEST.CurrentX = pointDXFx(i) - 8 PicDEST.CurrentY = pointDXFy(i) + 8 PicDEST.Print "Y" & i & "=" & pointDXFy(i) Next i End Sub Private Sub CBLANCERCALCULHELMERT_Click() 'repd contient les points dans les coordonnées du système à adapter '(j'ouvre le fichier DXF et je charge les points dans repd-> on met en forme la matrice M1) 'repa contient les coordonnées mesurées. '(je clique les points sur le plan scanné (picturebox) que je mets dans repa-> on met en forme la matrice M2) Dim repd() Dim repa() Dim maxpoint, nbpoint As Double Dim M1() As Double Dim M2() As Double Dim M3() As Double Dim M4() As Double Dim M5() As Double Dim residus() As Double Dim param(3) As Double Dim par As Double Dim moyennequadra As Double '*****************************************matinit****************************************' maxpoint = TxtnombredepointsDXF.Text nbpoint = TxtnombredepointsSCAN.Text 'vérifie les données et initialise '**********************************************' ReDim repd(maxpoint - 1, maxpoint - 1) 'on charge repd avec les points du DXF For i = 0 To maxpoint - 1 repd(i, 0) = pointDXFx(i + 1) repd(i, 1) = pointDXFy(i + 1) Next i '**********************************************' 'maxpoint = UBound(repd) + 1 'nbpoint = UBound(repa) + 1 If maxpoint <> nbpoint Then MsgBox "Calcul impossible, nombre de points différents dans chaque repère", vbOKOnly Exit Sub Else '**********************************************' ReDim repa(nbpoint - 1, nbpoint - 1) 'on charge repa avec les points cliqués sur le scan For i = 0 To maxpoint - 1 repa(i, 0) = pointSCANx(i + 1) repa(i, 1) = pointSCANy(i + 1) Next i '**********************************************' 'on met en forme les matrices ReDim M1(2 * maxpoint - 1, 3) 'A ReDim M2(2 * maxpoint - 1) 'K For i = 0 To maxpoint - 1 M1(2 * i, 0) = repd(i, 0) M1(2 * i, 1) = -repd(i, 1) M1(2 * i, 2) = 1 M1(2 * i, 3) = 0 M2(2 * i) = repa(i, 0) M1(2 * i + 1, 1) = repd(i, 0) M1(2 * i + 1, 0) = repd(i, 1) M1(2 * i + 1, 2) = 0 M1(2 * i + 1, 3) = 1 M2(2 * i + 1) = repa(i, 1) Next i End If '*********************************transmat***********************************************' ReDim M3(3, 2 * maxpoint - 1) 'calcul tA For j = 0 To 3 For i = 0 To 2 * maxpoint - 1 M3(j, i) = M1(i, j) Next i Next j '******************************** multmat()**********************************************' ReDim M4(3, 3) ReDim M5(3) 'calcul tAA For i = 0 To 3 For j = 0 To 3 M4(i, j) = 0 For k = 0 To 2 * maxpoint - 1 M4(i, j) = M4(i, j) + M3(i, k) * M1(k, j) Next k Next j Next i 'calcul de tAK For i = 0 To 3 M5(i) = 0 For j = 0 To 2 * maxpoint - 1 M5(i) = M5(i) + M3(i, j) * M2(j) Next j Next i '***********************************triangmat***********************************************' 'triangularisation de tAAX=tAK soit M4X=M5 For j = 0 To 2 i = j + 1 For k = i To 3 par = M4(k, j) / M4(i - 1, j) For l = j To 3 M4(k, l) = M4(k, l) - par * M4(i - 1, l) Next l M5(k) = M5(k) - par * M5(i - 1) Next k Next j '****************************************defparam*******************************************' param(3) = M5(3) / M4(3, 3) For i = 2 To 0 Step -1 par = 0 For j = i + 1 To 3 par = par + M4(i, j) * param(j) Next j param(i) = (M5(i) - par) / M4(i, i) Next i 'on affiche les paramètres a,b,p,q de la transformation d'HELMERT dans les textes sur la frame frmChoisirPointsSystèmeArrivée Txta.Text = param(0) Txtb.Text = param(1) Txtp.Text = param(2) Txtq.Text = param(3) '*****************calculresidus************************************************************' ReDim residus(2 * maxpoint - 1) For i = 0 To 2 * maxpoint - 1 residus(i) = 0 For j = 0 To 3 residus(i) = residus(i) + M1(i, j) * param(j) Next j Next i For i = 0 To maxpoint - 1 residus(i * 2) = residus(2 * i) - M2(i * 2) residus(2 * i + 1) = residus(2 * i + 1) - M2(2 * i + 1) Next i '*********************calculmoyquadra******************************************************' 'Dim w0, w1 As Double 'w0 = 0 'w1 = 0 'For i% = 0 To maxpoint - 1 'w0 = w0 + residus(2 * i%) * residus(2 * i%) 'w1 = w1 + residus(2 * i% + 1) * residus(2 * i% + 1) 'Next i% 'w0 = w0 / maxpoint 'w1 = w1 / maxpoint 'moyennequadra = Sqr(wo + w1) 'on recalcule les points transformés For i = 0 To maxpoint - 1 pointtransformex(i + 1) = param(0) * pointDXFx(i + 1) + param(1) * pointDXFy(i + 1) + param(2) pointtransformey(i + 1) = -param(1) * pointDXFx(i + 1) + param(0) * pointDXFy(i + 1) + param(3) 'au préalable : tous les textes ou label doivent exister et être d'indice 0 (Txttransformedex(0),TxttransformedeY(0),Lblpointtransforme(0)) 'on crée le nombre de texte et de label selon le nombre de points transformés Dim iNewItem As Integer 'Trouver l'index à créer iNewItem = Txttransformedex.UBound + 1 'Créer le nouveau contôle Txttransformedex et le positionner Load Txttransformedex(iNewItem) Txttransformedex(iNewItem).Top = Txttransformedex(iNewItem - 1).Top + Txttransformedex(iNewItem - 1).Height Txttransformedex(iNewItem).Left = Txttransformedex(iNewItem - 1).Left Txttransformedex(iNewItem).Visible = True Txttransformedex(iNewItem).Text = pointtransformex(iNewItem) Dim jNewItem As Integer 'Trouver l'index à créer jNewItem = TxttransformedeY.UBound + 1 'Créer le nouveau contôle Txttransformedey et le positionner Load TxttransformedeY(jNewItem) TxttransformedeY(jNewItem).Top = TxttransformedeY(jNewItem - 1).Top + TxttransformedeY(jNewItem - 1).Height TxttransformedeY(jNewItem).Left = TxttransformedeY(jNewItem - 1).Left TxttransformedeY(jNewItem).Visible = True TxttransformedeY(jNewItem).Text = pointtransformey(jNewItem) Dim kNewItem As Integer 'Trouver l'index à créer kNewItem = Lblpointtransforme.UBound + 1 'Créer le nouveau contôle Lblpointtransforme et le positionner Load Lblpointtransforme(kNewItem) Lblpointtransforme(kNewItem).Top = Lblpointtransforme(kNewItem - 1).Top + Lblpointtransforme(kNewItem - 1).Height Lblpointtransforme(kNewItem).Left = Lblpointtransforme(kNewItem - 1).Left Lblpointtransforme(kNewItem).Caption = "Point" & kNewItem & ":" Lblpointtransforme(kNewItem).Visible = True Next i 'on efface les points dessinés au préalable PicDEST.Cls i = 1 For i = 1 To maxpoint 'on dessine les points PicDEST.PSet (pointtransformex(i) * zoom, pointtransformey(i) * zoom), QBColor(4) 'on dessine les repères verticaux et horizontaux des points PicDEST.Line (pointtransformex(i) * zoom, pointtransformey(i) * zoom - 4)-(pointtransformex(i) * zoom, pointtransformey(i) * zoom + 4), RGB(0, 0, 255) PicDEST.Line (pointtransformex(i) * zoom - 4, pointtransformey(i) * zoom)-(pointtransformex(i) * zoom + 4, pointtransformey(i) * zoom), RGB(0, 0, 255) Next i PicDEST.ForeColor = vbRed For i = 1 To maxpoint 'affichage des textes des positions X et Y avec la valeur des points du dxf' PicDEST.CurrentX = pointtransformex(i) + 8 PicDEST.CurrentY = pointtransformey(i) - 8 PicDEST.Print "X" & i & "=" & pointDXFx(i) Next i For i = 1 To maxpoint PicDEST.CurrentX = pointtransformex(i) - 8 PicDEST.CurrentY = pointtransformey(i) + 8 PicDEST.Print "Y" & i & "=" & pointDXFy(i) Next i MsgBox "fin de la transformation d'helmert", vbOKOnly ChoisirPointsSystèmeArrivée = 0 'frmChoisirPointsSystèmeArrivée.Visible = False End Sub Private Sub Cbraz_Click() PicDEST.Cls Dim maxpoint, nbpoint As Double Dim iNewItem As Integer maxpoint = TxtnombredepointsDXF.Text For i = 1 To maxpoint Unload Txtscanx(i) Unload Txtscany(i) Unload Txttransformedex(i) Unload TxttransformedeY(i) Next i nombredepointsSystèmeArrivée = 0 TxtnombredepointsSCAN = 0 reponse = MsgBox("Veuillez Choisir les Points du Système d'Arrivée en les Cliquant consécutivement sur le Plan Scanné", vbYesNo) If reponse = vbYes Then nombredepointsSystèmeArrivée = 0 TxtnombredepointsSCAN.Text = 0 ChoisirPointsSystèmeArrivée = 1 End If End Sub Private Sub VScroll1_Change(index As Integer) Picinterne(index).Top = -VScroll1(index).Value End Sub Private Sub VScroll1_Scroll(index As Integer) Picinterne(index).Top = -VScroll1(index).Value End Sub Private Sub PicDEST_DragDrop(Source As Control, X As Single, Y As Single) 'permet de déplacer la frame frmChoisirPointsSystèmeArrivée sur picDEST If TypeOf Source Is Frame Then Source.Move X, Y End If End Sub
Hors ligne
#38 Fri 23 November 2007 01:58
- gigilogi
- Participant occasionnel
- Date d'inscription: 16 Nov 2007
- Messages: 14
Re: Transformations affines et corrections d'Helmert
l' erreur venait de ça :
Si on pose a= k*cos(teta) et b= k*sin(teta) alors l'helmert peut s'écrire
X= ax + by +p
Y = -bx + ay + q
l' helmert s'écrit plutot comme ça (et ça change tout) :
X=ax-by+p
Y=bx+ay+q
d'ou la formule finale :
'on recalcule les points transformés
For i = 0 To maxpoint - 1
'X = ax - by + p
'Y = bx + ay + q
pointtransformex(i + 1) = param(0) * pointDXFx(i + 1) - param(1) * pointDXFy(i + 1) + param(2)
pointtransformey(i + 1) = param(1) * pointDXFx(i + 1) + param(0) * pointDXFy(i + 1) + param(3)
next i
et quelque soit les fichiers de points DXF (parcelle décalée en rotation etc...)-> ça fonctionne impeccable.
merci quand même christophe.
Hors ligne
#39 Fri 23 November 2007 08:46
- ChristopheV
- Membre
- Lieu: Ajaccio
- Date d'inscription: 7 Sep 2005
- Messages: 3175
- Site web
Re: Transformations affines et corrections d'Helmert
Bonjour,
Ici nous sommes sur le forum "topographie", et les topographes utilisent un système de coordonnées où les angles sont orientés selon le sens horaire ! Donc la formule que je vous ais donnée est juste quand on adopte ce système. Mais s'il on veut l'utiliser avec un système de coordonnées "classique" (sens trigo pour les angles) elle s'écrit effectivement :
X=ax-by+p
Y=bx+ay+q
A+
Christophe
Christophe
L'avantage d'être une île c'est d'être une terre topologiquement close
Hors ligne
#40 Wed 29 February 2012 09:06
Re: Transformations affines et corrections d'Helmert
bonjour
je n'arrive plus à retrouver le raisonnement pour estimer la précision d'un levé à partir des résidus de l'adaptation d'Helmert [un sacré gaillard, disait on de lui ; ] du levé de contrôle sur le réseau vérifié.
ça vous dit quelque chose?
cordialement
«J’avais le sentiment que les itinéraires chantés ne se limitaient pas à l’Australie, mais constituaient un phénomène universel, le moyen par lequel les hommes marquaient leur territoire.»
Bruce Chatwin
Hors ligne
#41 Wed 29 February 2012 18:48
- LrDb
- Participant occasionnel
- Date d'inscription: 9 Aug 2011
- Messages: 34
Re: Transformations affines et corrections d'Helmert
Bonjour,
Pour une adaptation Helmert en topo:
EMQ=La racine carrée de la somme des écarts au carré divisé par n-1
exemple:résidus= 1; 2;3;4;5;5 résidus = distance euclidienne entre 2 points
1²+2²+3²+4²+5²+5² = 80
80/5=16
EMQ=4
Hors ligne
#42 Wed 29 February 2012 20:44
Re: Transformations affines et corrections d'Helmert
merci, c'est en effet l'estimateur de la variance
Mais ma question, surement mal posée, vise plutôt à estimer la précision absolue en position à partir des résidus issus du contrôle
cordialement
Dernière modification par urbanlog (Sun 04 March 2012 12:15)
«J’avais le sentiment que les itinéraires chantés ne se limitaient pas à l’Australie, mais constituaient un phénomène universel, le moyen par lequel les hommes marquaient leur territoire.»
Bruce Chatwin
Hors ligne
#43 Wed 29 February 2012 22:43
Re: Transformations affines et corrections d'Helmert
Tout dépend de ce que vous appelez contrôle et résidus Vous avez pour la France un arrêté sur les levers topo, leur précision et les contrôles de vérifications, qui vous donne la qualité de la mesure de contrôle, le nombre de point (d'échantillons) de à mesures à prendre pour avoir un indice de confiance convenable, puis l'écart à avoir sur les contrôles.
Si le contrôle ce n'est que la fermeture d'une polygonale, ce n'est plus vraiment la même chose. Et puis de toute façon, le rapport avec les transformations affines et M. Helmert, je ne vois pas trop.
Après le raisonnement, il est toujours simple : Vous supposez que vous ne faites pas de fautes, que tous les écarts de mesure sont "normaux" (gaussien) par rapport à la vérité, et alors on montre que l'écart-type des mesures vous donne 68 % des mesures "normales". Après, ça devient vite compliqué, car quand vous associez des variables qui suivent une loi normales, les résultats suivent plutôt une loi du chi-deux.
(Bien sûr, s'il faut un cours, il y a les cours pour ça )
Jérôme Cuinet
L'avantage de la Chine, c'est que le soleil se couche plus tard !
Hors ligne
#44 Sun 04 March 2012 12:20
Re: Transformations affines et corrections d'Helmert
@ Jeirhome
merci d'avoir pris du temps pour une réponse
je connais tout ça
donc ma question est très mal posée
bien cordialement
«J’avais le sentiment que les itinéraires chantés ne se limitaient pas à l’Australie, mais constituaient un phénomène universel, le moyen par lequel les hommes marquaient leur territoire.»
Bruce Chatwin
Hors ligne
#45 Sun 17 April 2016 12:22
- WYk
- Juste Inscrit !
- Lieu: montbrison
- Date d'inscription: 8 Jan 2016
- Messages: 2
Re: Transformations affines et corrections d'Helmert
Bonjour à tous
Je déterre un post en espérant que je trouve un echo
J'ai un souci également de changement de projection
Je ne suis cependant pas en Lambert 93 ou autre mais simplement en donnée locale par rapport à une origine arbitraire.
J'ai donc des point x, y, z
Je souhaiterai pouvoir changer cette origine mais aussi changer l'orientation de l'axe des x à partir de mon origine et d'un point choisi...
Si quelqu'un avait la formule magique, cela e rendrai un énorme service........
merci d'avance
Hors ligne