Discussion :

[perchman]

Bonjour à tous,

voilà, j'ai un exercice où je dois comparer des points 1 à 1, calculer la distance entre eux, retourner la distance max puis donner la paire de points qui est concernée.

ex: prenons 5 points (a, b, c, d et e)
le programme doit comparer:
a avec b
a avec c
a avec d
a avec e
puis
b avec c
b avec d
b avec e
...

voici mon code correspondant à cet exo (qui ne marche pas):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
'code du test
Sub td2_4()
    Dim t1(5) As point
    Call saisie_point(t1(0))
    Call saisie_point(t1(1))
    Call saisie_point(t1(2))
    Call saisie_point(t1(3))
    Call saisie_point(t1(4))
    Call copy_point(t1, 5)
End Sub
 
'saisie d'un point
Sub saisie_point(ByRef p As point)
    p.x = InputBox("Point 1: Entrer x: ")
    p.y = InputBox("Point 1: Entrer y:")
End Sub
 
'fonction qui permet de connaitre la distance entre 2 points
Function distance(p1 As point, p2 As point) As Double
    Dim result As Double
    result = Sqr((p2.x - p1.x) ^ 2 + (p2.y - p1.y) ^ 2)
    distance = result
End Function
 
'copie du tableau de point dans un nouveau tableau et recherche du max
Sub copy_point(t1() As point, ByVal nbelement As Integer)
    Dim tc() As point
    Dim i As Integer
    Dim j As Integer
    Dim n As Integer
    Dim d As Integer
    Dim max As Integer
 
    max = 0
    n = 0
 
    For i = 0 To nbelement - 1
        tc(i) = t1(i)    'y a un problème ici:aie:
    Next i
 
    For i = 0 To nbelement - 1
        For j = n + 1 To nbelement - 2
            Call distance(tc(j), t1(i))
            d = distance(tc(j), t1(i))
                If d > max Then
                    max = d
                    MsgBox (max)
                End If
        Next j
        n = n + 1
    Next i
    MsgBox ("le max est de :" & max)
End Sub

[perchman]

Bon ben j'ai une solution !!

Je pense qu'il y a plus simple, mais apparemment, elle marche !!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub copy_point(t1() As point, ByVal nbelement As Integer)
    Dim tc() As point
    Dim i As Integer
    Dim j As Integer
    Dim n As Integer
    Dim d As Integer
    Dim max As Integer
    Dim imax As Integer
    Dim jmax As Integer
 
    max = 0
    n = 0
 
    tc = t1
 
    For i = 0 To nbelement - 1
        For j = n + 1 To nbelement - 2
            Call distance(tc(j), t1(i))
            d = distance(tc(j), t1(i))
                If d > max Then
                    max = d
                    imax = i
                    jmax = j
                End If
        Next j
        n = n + 1
    Next i
    MsgBox ("Le max est de : " & max & " et est entre les points: " & imax & " et " & jmax)
End Sub

Merci