jawa
05-03-2005, 08:31 PM
Hi am new to this forum and am not an experienced user of visual basic. I am trying to write a macro in excel that identifies points that are within a certain distance of the point. Points that are within a certain distance of the point are then assigned the same group number.
The macro I have written reads in a list of data points (x,y,z), calculates the distance from each point to all other points and writes into an array called ?neighbours? the row positions of all events that are with the search distance of each point. It then assigns a Cluster or group ID to each point within the search radius, for each data point. To be assigned the same cluster ID, the current macro requires all points to be within the search radius of each other. This is not what I want. I would like an event to be included in the group ID if it is within 5m of any event of the group. Does that make sense? For example a series of points in a line with each point 5m apart. All of this points should be given the same group ID however the current macro assigns separate IDs to each point set with the exception of the last two points in the list.
Any help is much appreciated. Also are there any ways to speed the process up?
Regards
JA
Sub Clustering()
NumberEvents = Worksheets("DataBase").Cells(2, 1).Value
RefDistance = Worksheets("DataBase").Cells(14, 9).Value
'Declare Arrays
Dim EventX(1 To 17000) As Single
Dim EventY(1 To 17000) As Single
Dim EventZ(1 To 17000) As Single
Dim Neighbours(1 To 17000, 1 To 17000) As Integer
'Empty Arrays
For i = 1 To NumberEvents
EventX(i) = 0
EventY(i) = 0
EventZ(i) = 0
Next i
For i = 1 To NumberEvents
For j = 1 To 100
Neighbours(i, j) = 0
Next j
Next i
'Store Data
For i = 1 To NumberEvents
EventX(i) = CSng(Worksheets("DataBase").Cells(i + 2, 2).Value)
EventY(i) = CSng(Worksheets("DataBase").Cells(i + 2, 3).Value)
EventZ(i) = CSng(Worksheets("DataBase").Cells(i + 2, 4).Value)
Next i
'1) Determine Event Neighbours
For i = 1 To NumberEvents
k = 1
For j = 1 To NumberEvents
DeltaX = EventX(i) - EventX(j)
DeltaY = EventY(i) - EventY(j)
DeltaZ = EventZ(i) - EventZ(j)
Distance = Sqr(((DeltaX) * (DeltaX)) + ((DeltaY) * (DeltaY)) + ((DeltaZ) * (DeltaZ)))
If Distance < RefDistance Then
Neighbours(i, k) = j
k = k + 1
End If
Next j
Next i
'2) Assign Cluster_ID
CID = 1
For i = 1 To NumberEvents
If Worksheets("DataBase").Cells(i, 5).Value = "" Then
For j = 1 To 300
If Neighbours(i, j) > 0 Then
k = Neighbours(i, j)
Worksheets("DataBase").Cells(k + 2, 5).Value = CID
End If
Next j
CID = CID + 1
Next i
End Sub
The macro I have written reads in a list of data points (x,y,z), calculates the distance from each point to all other points and writes into an array called ?neighbours? the row positions of all events that are with the search distance of each point. It then assigns a Cluster or group ID to each point within the search radius, for each data point. To be assigned the same cluster ID, the current macro requires all points to be within the search radius of each other. This is not what I want. I would like an event to be included in the group ID if it is within 5m of any event of the group. Does that make sense? For example a series of points in a line with each point 5m apart. All of this points should be given the same group ID however the current macro assigns separate IDs to each point set with the exception of the last two points in the list.
Any help is much appreciated. Also are there any ways to speed the process up?
Regards
JA
Sub Clustering()
NumberEvents = Worksheets("DataBase").Cells(2, 1).Value
RefDistance = Worksheets("DataBase").Cells(14, 9).Value
'Declare Arrays
Dim EventX(1 To 17000) As Single
Dim EventY(1 To 17000) As Single
Dim EventZ(1 To 17000) As Single
Dim Neighbours(1 To 17000, 1 To 17000) As Integer
'Empty Arrays
For i = 1 To NumberEvents
EventX(i) = 0
EventY(i) = 0
EventZ(i) = 0
Next i
For i = 1 To NumberEvents
For j = 1 To 100
Neighbours(i, j) = 0
Next j
Next i
'Store Data
For i = 1 To NumberEvents
EventX(i) = CSng(Worksheets("DataBase").Cells(i + 2, 2).Value)
EventY(i) = CSng(Worksheets("DataBase").Cells(i + 2, 3).Value)
EventZ(i) = CSng(Worksheets("DataBase").Cells(i + 2, 4).Value)
Next i
'1) Determine Event Neighbours
For i = 1 To NumberEvents
k = 1
For j = 1 To NumberEvents
DeltaX = EventX(i) - EventX(j)
DeltaY = EventY(i) - EventY(j)
DeltaZ = EventZ(i) - EventZ(j)
Distance = Sqr(((DeltaX) * (DeltaX)) + ((DeltaY) * (DeltaY)) + ((DeltaZ) * (DeltaZ)))
If Distance < RefDistance Then
Neighbours(i, k) = j
k = k + 1
End If
Next j
Next i
'2) Assign Cluster_ID
CID = 1
For i = 1 To NumberEvents
If Worksheets("DataBase").Cells(i, 5).Value = "" Then
For j = 1 To 300
If Neighbours(i, j) > 0 Then
k = Neighbours(i, j)
Worksheets("DataBase").Cells(k + 2, 5).Value = CID
End If
Next j
CID = CID + 1
Next i
End Sub