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 (17 years, 8 months ago) by bournival
File size:	11140 byte(s)
Log Message:	Projet de these de Sylvain Bournival. Attention projet VB.
#	Content
1	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