REPOS_ERICCA/magicsld/grille.vb

Public Class point_grille
    Private xyz(2) As Double
    Private id As Integer

    Public Sub New(ByVal x As Double, ByVal y As Double, ByVal z As Double, ByVal indice As Integer)
        xyz(0) = x
        xyz(1) = y
        xyz(2) = z
        id = indice ' indice du points dans le tableau PogCode - tabpoints
    End Sub
    Public Sub New(ByRef x() As Double, ByVal indice As Integer)
        xyz(0) = x(0)
        xyz(1) = x(1)
        xyz(2) = x(2)
        id = indice ' indice du points dans le tableau PogCode - tabpoints
    End Sub
    Public Function get_x() As Double
        Return xyz(0)
    End Function
    Public Function get_y() As Double
        Return xyz(1)
    End Function
    Public Function get_z() As Double
        Return xyz(2)
    End Function
    Public Sub get_coord(ByRef x() As Double)
        x(0) = xyz(0)
        x(1) = xyz(1)
        x(2) = xyz(2)
    End Sub
    Public Function get_id() As Integer
        Return id
    End Function
End Class

Public Class case_grille
    Private xyz(2) As Double
    REM Private dxyz(2) As Double
    Private lst_point_grille As New Collection

    Public Sub New(ByVal x As Double, ByVal y As Double, ByVal z As Double) REM , ByVal dx As Double, ByVal dy As Double, ByVal dz As Double)
        xyz(0) = x
        xyz(1) = y
        xyz(2) = z
        REM dxyz(0) = dx
        REM dxyz(1) = dy
        REM dxyz(2) = dz
    End Sub

    Public Sub add_point_grille(ByRef ptgr As point_grille)
        lst_point_grille.Add(ptgr)
    End Sub
    Public Sub rm_point_grille(ByVal id As Integer)
        lst_point_grille.Remove(id)
    End Sub
    Public Function get_nb_point_grille() As Integer
        Return lst_point_grille.Count
    End Function
    Public Function get_point_grille(ByVal num As Integer) As point_grille
        Return (lst_point_grille.Item(num))
    End Function
    Protected Overrides Sub Finalize()
        Do While lst_point_grille.Count <> 0
            lst_point_grille.Remove(1)
        Loop
        MyBase.Finalize()
    End Sub
End Class

Public Class grille
    Private xyz(2) As Double
    Private dxyz(2) As Double
    Private lst_case_grille() As case_grille
    'Private lst_case_grille As New Collection
    Private pasx As Double
    Private pasy As Double
    Private pasz As Double
    Private nbpasx As Integer
    Private nbpasy As Integer
    Private nbpasz As Integer

    Public Sub New()
    End Sub
    Public Sub initialiser(ByVal xmin As Double, ByVal ymin As Double, ByVal zmin As Double, ByVal xmax As Double, ByVal ymax As Double, ByVal zmax As Double, ByVal nb_pasx As Integer, ByVal nb_pasy As Integer, ByVal nb_pasz As Integer)
        nbpasx = nb_pasx
        nbpasy = nb_pasy
        nbpasz = nb_pasz
        If nbpasx = 0 Then
            nbpasx = 1
            If Math.Abs(xmin - xmax) < 0.0000000001 Then
                xmax = xmax + 0.05
                xmin = xmin - 0.05
            End If
        End If
        If nbpasy = 0 Then
            nbpasy = 1
            If Math.Abs(ymin - ymax) < 0.0000000001 Then
                ymax = ymax + 0.05
                ymin = ymin - 0.05
            End If
        End If
        If nbpasz = 0 Then
            nbpasz = 1
            If Math.Abs(zmin - zmax) < 0.0000000001 Then
                zmax = zmax + 0.05
                zmin = zmin - 0.05
            End If
        End If
        pasx = (xmax - xmin) / nbpasx
        pasy = (ymax - ymin) / nbpasy
        pasz = (zmax - zmin) / nbpasz
        xyz(0) = xmin
        xyz(1) = ymin
        xyz(2) = zmin
        dxyz(0) = xmax - xmin
        dxyz(1) = ymax - ymin
        dxyz(2) = zmax - zmin
        Dim i As Integer, j As Integer, k As Integer
        Dim x1 As Double, x2 As Double
        Dim y1 As Double, y2 As Double
        Dim z1 As Double, z2 As Double
        Dim cagr As case_grille

        ReDim lst_case_grille((nbpasx + 1) * (nbpasy + 1) * (nbpasz + 1))

        For k = 0 To nbpasz
            For j = 0 To nbpasy
                For i = 0 To nbpasx
                    x1 = xmin + i * pasx
                    y1 = ymin + j * pasy
                    z1 = zmin + k * pasz
                    x2 = xmin + (i + 1) * pasx
                    y2 = ymin + (j + 1) * pasy
                    z2 = zmin + (k + 1) * pasz
                    cagr = New case_grille(x1, y1, z1)
                    Dim num As Long
                    num = i + j * nbpasx + k * nbpasy * nbpasx + 1
                    lst_case_grille(num) = cagr
                Next
            Next
        Next
    End Sub

    Public Sub get_cellule(ByVal x As Double, ByVal y As Double, ByVal z As Double, ByRef cellgrille As case_grille)
        Dim nx As Integer
        Dim ny As Integer
        Dim nz As Integer
        Dim num As Long
        nx = Int((x - xyz(0)) / pasx)
        ny = Int((y - xyz(1)) / pasy)
        nz = Int((z - xyz(2)) / pasz)
        num = nx + ny * nbpasx + nz * nbpasy * nbpasx + 1
        cellgrille = lst_case_grille((num))
    End Sub
    Public Sub get_cellule(ByVal nx As Integer, ByVal ny As Integer, ByVal nz As Integer, ByRef cellgrille As case_grille)
        Dim num As Long
        num = nx + ny * nbpasx + nz * nbpasy * nbpasx + 1
        If (num <= 0) Or (num > nbpasx * nbpasy * nbpasz) Then
            cellgrille = Nothing
            Return
        End If
        cellgrille = lst_case_grille(num)
    End Sub

    Public Sub inserer(ByRef ptgr As point_grille)
        Dim cagr As case_grille
        get_cellule(ptgr.get_x(), ptgr.get_y(), ptgr.get_z(), cagr)
        cagr.add_point_grille(ptgr)
    End Sub

    Public Sub rechercher(ByVal xc As Double, ByVal yc As Double, ByVal zc As Double, ByVal rayon As Double, ByRef lst_pt_grille_trouve As Collection)
        Dim bxmin As Double
        Dim bymin As Double
        Dim bzmin As Double
        Dim bxmax As Double
        Dim bymax As Double
        Dim bzmax As Double

        bxmin = xc - rayon
        bymin = yc - rayon
        bzmin = zc - rayon
        bxmax = xc + rayon
        bymax = yc + rayon
        bzmax = zc + rayon
        Dim nxmin As Integer = Int((bxmin - xyz(0)) / pasx)
        Dim nxmax As Integer = Int((bxmax - xyz(0)) / pasx)
        Dim nymin As Integer = Int((bymin - xyz(1)) / pasy)
        Dim nymax As Integer = Int((bymax - xyz(1)) / pasy)
        Dim nzmin As Integer = Int((bzmin - xyz(2)) / pasz)
        Dim nzmax As Integer = Int((bzmax - xyz(2)) / pasz)

        If nxmin < 0 Then nxmin = 0
        If nymin < 0 Then nymin = 0
        If nzmin < 0 Then nzmin = 0
        If nxmin > nbpasx - 1 Then nxmin = nbpasx - 1
        If nymin > nbpasy - 1 Then nymin = nbpasy - 1
        If nzmin > nbpasz - 1 Then nzmin = nbpasz - 1

        If nxmax < 0 Then nxmax = 0
        If nymax < 0 Then nymax = 0
        If nzmax < 0 Then nzmax = 0
        If nxmax > nbpasx - 1 Then nxmax = nbpasx - 1
        If nymax > nbpasy - 1 Then nymax = nbpasy - 1
        If nzmax > nbpasz - 1 Then nzmax = nbpasz - 1

        Dim i As Integer, j As Integer, k As Integer, kk As Integer, nb As Integer
        Dim xx As Double, yy As Double, zz As Double, dist As Double

        Dim cellgrille As case_grille
        Dim ptgrille As point_grille
        For i = nxmin To nxmax
            For j = nymin To nymax
                For k = nzmin To nzmax
                    get_cellule(i, j, k, cellgrille)
                    If Not cellgrille Is Nothing Then
                        nb = cellgrille.get_nb_point_grille()
                        For kk = 1 To nb
                            ptgrille = cellgrille.get_point_grille(kk)
                            xx = ptgrille.get_x() - xc
                            yy = ptgrille.get_y() - yc
                            zz = ptgrille.get_z() - zc
                            dist = xx * xx + yy * yy + zz * zz
                            If dist < rayon * rayon + (xx + yy + zz) * 0.0000000002 Then
                                lst_pt_grille_trouve.Add(ptgrille)
                            End If

                        Next
                    End If
                Next
            Next
        Next

    End Sub
    Public Function chercher(ByVal xc As Double, ByVal yc As Double, ByVal zc As Double, ByVal rayon As Double) As Boolean
        Dim bxmin As Double
        Dim bymin As Double
        Dim bzmin As Double
        Dim bxmax As Double
        Dim bymax As Double
        Dim bzmax As Double

        bxmin = xc - rayon
        bymin = yc - rayon
        bzmin = zc - rayon
        bxmax = xc + rayon
        bymax = yc + rayon
        bzmax = zc + rayon
        Dim nxmin As Integer = Int((bxmin - xyz(0)) / pasx)
        Dim nxmax As Integer = Int((bxmax - xyz(0)) / pasx)
        Dim nymin As Integer = Int((bymin - xyz(1)) / pasy)
        Dim nymax As Integer = Int((bymax - xyz(1)) / pasy)
        Dim nzmin As Integer = Int((bzmin - xyz(2)) / pasz)
        Dim nzmax As Integer = Int((bzmax - xyz(2)) / pasz)

        If nxmin < 0 Then nxmin = 0
        If nymin < 0 Then nymin = 0
        If nzmin < 0 Then nzmin = 0
        If nxmin > nbpasx - 1 Then nxmin = nbpasx - 1
        If nymin > nbpasy - 1 Then nymin = nbpasy - 1
        If nzmin > nbpasz - 1 Then nzmin = nbpasz - 1

        If nxmax < 0 Then nxmax = 0
        If nymax < 0 Then nymax = 0
        If nzmax < 0 Then nzmax = 0
        If nxmax > nbpasx - 1 Then nxmax = nbpasx - 1
        If nymax > nbpasy - 1 Then nymax = nbpasy - 1
        If nzmax > nbpasz - 1 Then nzmax = nbpasz - 1

        Dim i As Integer, j As Integer, k As Integer, kk As Integer, nb As Integer
        Dim xx As Double, yy As Double, zz As Double, dist As Double

        chercher = False
        Dim cellgrille As case_grille
        Dim ptgrille As point_grille
        For i = nxmin To nxmax
            For j = nymin To nymax
                For k = nzmin To nzmax
                    get_cellule(i, j, k, cellgrille)
                    If Not cellgrille Is Nothing Then
                        nb = cellgrille.get_nb_point_grille()
                        For kk = 1 To nb
                            ptgrille = cellgrille.get_point_grille(kk)
                            xx = ptgrille.get_x() - xc
                            yy = ptgrille.get_y() - yc
                            zz = ptgrille.get_z() - zc
                            dist = xx * xx + yy * yy + zz * zz
                            If dist < rayon * rayon + (xx + yy + zz) * 0.0000000002 Then
                                Return True
                            End If

                        Next
                    End If
                Next
            Next
        Next

    End Function

    Protected Overrides Sub Finalize()
        REM Do While lst_case_grille.GetLength() <> 0
        REM lst_case_grille.Remove(1)
        REM Loop
        MyBase.Finalize()
    End Sub
End Class
Revision:	40
Committed:	Mon Aug 20 21:30:28 2007 UTC (18 years ago) by bournival
File size:	11140 byte(s)
Log Message:	Projet de these de Sylvain Bournival. Attention projet VB.
#	User	Rev	Content
1	bournival	40	Public Class point_grille
2			Private xyz(2) As Double
3			Private id As Integer
4
5			Public Sub New(ByVal x As Double, ByVal y As Double, ByVal z As Double, ByVal indice As Integer)
6			xyz(0) = x
7			xyz(1) = y
8			xyz(2) = z
9			id = indice ' indice du points dans le tableau PogCode - tabpoints
10			End Sub
11			Public Sub New(ByRef x() As Double, ByVal indice As Integer)
12			xyz(0) = x(0)
13			xyz(1) = x(1)
14			xyz(2) = x(2)
15			id = indice ' indice du points dans le tableau PogCode - tabpoints
16			End Sub
17			Public Function get_x() As Double
18			Return xyz(0)
19			End Function
20			Public Function get_y() As Double
21			Return xyz(1)
22			End Function
23			Public Function get_z() As Double
24			Return xyz(2)
25			End Function
26			Public Sub get_coord(ByRef x() As Double)
27			x(0) = xyz(0)
28			x(1) = xyz(1)
29			x(2) = xyz(2)
30			End Sub
31			Public Function get_id() As Integer
32			Return id
33			End Function
34			End Class
35
36			Public Class case_grille
37			Private xyz(2) As Double
38			REM Private dxyz(2) As Double
39			Private lst_point_grille As New Collection
40
41			Public Sub New(ByVal x As Double, ByVal y As Double, ByVal z As Double) REM , ByVal dx As Double, ByVal dy As Double, ByVal dz As Double)
42			xyz(0) = x
43			xyz(1) = y
44			xyz(2) = z
45			REM dxyz(0) = dx
46			REM dxyz(1) = dy
47			REM dxyz(2) = dz
48			End Sub
49
50			Public Sub add_point_grille(ByRef ptgr As point_grille)
51			lst_point_grille.Add(ptgr)
52			End Sub
53			Public Sub rm_point_grille(ByVal id As Integer)
54			lst_point_grille.Remove(id)
55			End Sub
56			Public Function get_nb_point_grille() As Integer
57			Return lst_point_grille.Count
58			End Function
59			Public Function get_point_grille(ByVal num As Integer) As point_grille
60			Return (lst_point_grille.Item(num))
61			End Function
62			Protected Overrides Sub Finalize()
63			Do While lst_point_grille.Count <> 0
64			lst_point_grille.Remove(1)
65			Loop
66			MyBase.Finalize()
67			End Sub
68			End Class
69
70			Public Class grille
71			Private xyz(2) As Double
72			Private dxyz(2) As Double
73			Private lst_case_grille() As case_grille
74			'Private lst_case_grille As New Collection
75			Private pasx As Double
76			Private pasy As Double
77			Private pasz As Double
78			Private nbpasx As Integer
79			Private nbpasy As Integer
80			Private nbpasz As Integer
81
82			Public Sub New()
83			End Sub
84			Public Sub initialiser(ByVal xmin As Double, ByVal ymin As Double, ByVal zmin As Double, ByVal xmax As Double, ByVal ymax As Double, ByVal zmax As Double, ByVal nb_pasx As Integer, ByVal nb_pasy As Integer, ByVal nb_pasz As Integer)
85			nbpasx = nb_pasx
86			nbpasy = nb_pasy
87			nbpasz = nb_pasz
88			If nbpasx = 0 Then
89			nbpasx = 1
90			If Math.Abs(xmin - xmax) < 0.0000000001 Then
91			xmax = xmax + 0.05
92			xmin = xmin - 0.05
93			End If
94			End If
95			If nbpasy = 0 Then
96			nbpasy = 1
97			If Math.Abs(ymin - ymax) < 0.0000000001 Then
98			ymax = ymax + 0.05
99			ymin = ymin - 0.05
100			End If
101			End If
102			If nbpasz = 0 Then
103			nbpasz = 1
104			If Math.Abs(zmin - zmax) < 0.0000000001 Then
105			zmax = zmax + 0.05
106			zmin = zmin - 0.05
107			End If
108			End If
109			pasx = (xmax - xmin) / nbpasx
110			pasy = (ymax - ymin) / nbpasy
111			pasz = (zmax - zmin) / nbpasz
112			xyz(0) = xmin
113			xyz(1) = ymin
114			xyz(2) = zmin
115			dxyz(0) = xmax - xmin
116			dxyz(1) = ymax - ymin
117			dxyz(2) = zmax - zmin
118			Dim i As Integer, j As Integer, k As Integer
119			Dim x1 As Double, x2 As Double
120			Dim y1 As Double, y2 As Double
121			Dim z1 As Double, z2 As Double
122			Dim cagr As case_grille
123
124			ReDim lst_case_grille((nbpasx + 1) * (nbpasy + 1) * (nbpasz + 1))
125
126			For k = 0 To nbpasz
127			For j = 0 To nbpasy
128			For i = 0 To nbpasx
129			x1 = xmin + i * pasx
130			y1 = ymin + j * pasy
131			z1 = zmin + k * pasz
132			x2 = xmin + (i + 1) * pasx
133			y2 = ymin + (j + 1) * pasy
134			z2 = zmin + (k + 1) * pasz
135			cagr = New case_grille(x1, y1, z1)
136			Dim num As Long
137			num = i + j * nbpasx + k * nbpasy * nbpasx + 1
138			lst_case_grille(num) = cagr
139			Next
140			Next
141			Next
142			End Sub
143
144			Public Sub get_cellule(ByVal x As Double, ByVal y As Double, ByVal z As Double, ByRef cellgrille As case_grille)
145			Dim nx As Integer
146			Dim ny As Integer
147			Dim nz As Integer
148			Dim num As Long
149			nx = Int((x - xyz(0)) / pasx)
150			ny = Int((y - xyz(1)) / pasy)
151			nz = Int((z - xyz(2)) / pasz)
152			num = nx + ny * nbpasx + nz * nbpasy * nbpasx + 1
153			cellgrille = lst_case_grille((num))
154			End Sub
155			Public Sub get_cellule(ByVal nx As Integer, ByVal ny As Integer, ByVal nz As Integer, ByRef cellgrille As case_grille)
156			Dim num As Long
157			num = nx + ny * nbpasx + nz * nbpasy * nbpasx + 1
158			If (num <= 0) Or (num > nbpasx * nbpasy * nbpasz) Then
159			cellgrille = Nothing
160			Return
161			End If
162			cellgrille = lst_case_grille(num)
163			End Sub
164
165			Public Sub inserer(ByRef ptgr As point_grille)
166			Dim cagr As case_grille
167			get_cellule(ptgr.get_x(), ptgr.get_y(), ptgr.get_z(), cagr)
168			cagr.add_point_grille(ptgr)
169			End Sub
170
171			Public Sub rechercher(ByVal xc As Double, ByVal yc As Double, ByVal zc As Double, ByVal rayon As Double, ByRef lst_pt_grille_trouve As Collection)
172			Dim bxmin As Double
173			Dim bymin As Double
174			Dim bzmin As Double
175			Dim bxmax As Double
176			Dim bymax As Double
177			Dim bzmax As Double
178
179			bxmin = xc - rayon
180			bymin = yc - rayon
181			bzmin = zc - rayon
182			bxmax = xc + rayon
183			bymax = yc + rayon
184			bzmax = zc + rayon
185			Dim nxmin As Integer = Int((bxmin - xyz(0)) / pasx)
186			Dim nxmax As Integer = Int((bxmax - xyz(0)) / pasx)
187			Dim nymin As Integer = Int((bymin - xyz(1)) / pasy)
188			Dim nymax As Integer = Int((bymax - xyz(1)) / pasy)
189			Dim nzmin As Integer = Int((bzmin - xyz(2)) / pasz)
190			Dim nzmax As Integer = Int((bzmax - xyz(2)) / pasz)
191
192			If nxmin < 0 Then nxmin = 0
193			If nymin < 0 Then nymin = 0
194			If nzmin < 0 Then nzmin = 0
195			If nxmin > nbpasx - 1 Then nxmin = nbpasx - 1
196			If nymin > nbpasy - 1 Then nymin = nbpasy - 1
197			If nzmin > nbpasz - 1 Then nzmin = nbpasz - 1
198
199			If nxmax < 0 Then nxmax = 0
200			If nymax < 0 Then nymax = 0
201			If nzmax < 0 Then nzmax = 0
202			If nxmax > nbpasx - 1 Then nxmax = nbpasx - 1
203			If nymax > nbpasy - 1 Then nymax = nbpasy - 1
204			If nzmax > nbpasz - 1 Then nzmax = nbpasz - 1
205
206			Dim i As Integer, j As Integer, k As Integer, kk As Integer, nb As Integer
207			Dim xx As Double, yy As Double, zz As Double, dist As Double
208
209			Dim cellgrille As case_grille
210			Dim ptgrille As point_grille
211			For i = nxmin To nxmax
212			For j = nymin To nymax
213			For k = nzmin To nzmax
214			get_cellule(i, j, k, cellgrille)
215			If Not cellgrille Is Nothing Then
216			nb = cellgrille.get_nb_point_grille()
217			For kk = 1 To nb
218			ptgrille = cellgrille.get_point_grille(kk)
219			xx = ptgrille.get_x() - xc
220			yy = ptgrille.get_y() - yc
221			zz = ptgrille.get_z() - zc
222			dist = xx * xx + yy * yy + zz * zz
223			If dist < rayon * rayon + (xx + yy + zz) * 0.0000000002 Then
224			lst_pt_grille_trouve.Add(ptgrille)
225			End If
226
227			Next
228			End If
229			Next
230			Next
231			Next
232
233			End Sub
234			Public Function chercher(ByVal xc As Double, ByVal yc As Double, ByVal zc As Double, ByVal rayon As Double) As Boolean
235			Dim bxmin As Double
236			Dim bymin As Double
237			Dim bzmin As Double
238			Dim bxmax As Double
239			Dim bymax As Double
240			Dim bzmax As Double
241
242			bxmin = xc - rayon
243			bymin = yc - rayon
244			bzmin = zc - rayon
245			bxmax = xc + rayon
246			bymax = yc + rayon
247			bzmax = zc + rayon
248			Dim nxmin As Integer = Int((bxmin - xyz(0)) / pasx)
249			Dim nxmax As Integer = Int((bxmax - xyz(0)) / pasx)
250			Dim nymin As Integer = Int((bymin - xyz(1)) / pasy)
251			Dim nymax As Integer = Int((bymax - xyz(1)) / pasy)
252			Dim nzmin As Integer = Int((bzmin - xyz(2)) / pasz)
253			Dim nzmax As Integer = Int((bzmax - xyz(2)) / pasz)
254
255			If nxmin < 0 Then nxmin = 0
256			If nymin < 0 Then nymin = 0
257			If nzmin < 0 Then nzmin = 0
258			If nxmin > nbpasx - 1 Then nxmin = nbpasx - 1
259			If nymin > nbpasy - 1 Then nymin = nbpasy - 1
260			If nzmin > nbpasz - 1 Then nzmin = nbpasz - 1
261
262			If nxmax < 0 Then nxmax = 0
263			If nymax < 0 Then nymax = 0
264			If nzmax < 0 Then nzmax = 0
265			If nxmax > nbpasx - 1 Then nxmax = nbpasx - 1
266			If nymax > nbpasy - 1 Then nymax = nbpasy - 1
267			If nzmax > nbpasz - 1 Then nzmax = nbpasz - 1
268
269			Dim i As Integer, j As Integer, k As Integer, kk As Integer, nb As Integer
270			Dim xx As Double, yy As Double, zz As Double, dist As Double
271
272			chercher = False
273			Dim cellgrille As case_grille
274			Dim ptgrille As point_grille
275			For i = nxmin To nxmax
276			For j = nymin To nymax
277			For k = nzmin To nzmax
278			get_cellule(i, j, k, cellgrille)
279			If Not cellgrille Is Nothing Then
280			nb = cellgrille.get_nb_point_grille()
281			For kk = 1 To nb
282			ptgrille = cellgrille.get_point_grille(kk)
283			xx = ptgrille.get_x() - xc
284			yy = ptgrille.get_y() - yc
285			zz = ptgrille.get_z() - zc
286			dist = xx * xx + yy * yy + zz * zz
287			If dist < rayon * rayon + (xx + yy + zz) * 0.0000000002 Then
288			Return True
289			End If
290
291			Next
292			End If
293			Next
294			Next
295			Next
296
297			End Function
298
299			Protected Overrides Sub Finalize()
300			REM Do While lst_case_grille.GetLength() <> 0
301			REM lst_case_grille.Remove(1)
302			REM Loop
303			MyBase.Finalize()
304			End Sub
305			End Class