Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
226 lines (210 sloc) 6.51 KB
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ArrayUtilities.rvb -- January 2011
' If this code works, it was written by Dale Fugier.
' If not, I don't know who wrote it.
' Works with Rhino 4.0.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Verifies that the array has been dimmed.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function IsArrayDim(ByVal arr)
IsArrayDim = False
If IsArray(arr) Then
On Error Resume Next
Call UBound(arr)
If Err.Number = 0 Then IsArrayDim = True
End If
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Returns the number of dimensions to an array
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetArrayDim(ByVal arr)
Dim i
If IsArray(arr) Then
For i = 1 To 60
On Error Resume Next
Call UBound(arr, i)
If Err.Number <> 0 Then
GetArrayDim = i - 1
Exit Function
End If
Next
GetArrayDim = i
Else
GetArrayDim = Null
End If
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Adds a new element to the end of the array.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ArrayAdd(ByRef arr, ByVal val)
Dim ub
If IsArray(arr) Then
On Error Resume Next
ub = UBound(arr)
If Err.Number <> 0 Then ub = -1
ReDim Preserve arr(ub + 1)
arr(UBound(arr)) = val
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Appends another array to the end of the array.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ArrayAppend(ByRef arr, ByVal arr0)
Dim i, ub
If IsArray(arr) And IsArray(arr0) Then
On Error Resume Next
ub = UBound(arr)
If Err.Number <> 0 Then ub = -1
ReDim Preserve arr(ub + UBound(arr0) + 1)
For i = 0 To UBound(arr0)
arr(ub + 1 + i) = arr0(i)
Next
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Inserts a new element at a given position in the array.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ArrayInsert(ByRef arr, ByVal pos, ByVal val)
Dim i
If IsArray(arr) Then
If pos > UBound(arr) Then
Call ArrayAdd(arr, val)
ElseIf pos >= 0 Then
ReDim Preserve arr(UBound(arr) + 1)
For i = UBound(arr) To pos + 1 Step -1
arr(i) = arr(i - 1)
Next
arr(pos) = val
End If
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Removes an element from the end of the array.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ArrayRemove(ByRef arr)
If IsArray(arr) Then
If UBound(arr) > -1 Then
ReDim Preserve arr(UBound(arr) - 1)
End If
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Removes an element at a given position from the array.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ArrayRemoveAt(ByRef arr, ByVal pos)
Dim i
If IsArray(arr) Then
If pos >= 0 And pos <= UBound(arr) Then
For i = pos To UBound(arr) - 1
arr(i) = arr(i + 1)
Next
ReDim Preserve arr(UBound(arr) - 1)
End If
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Removes all instances of a value from the array.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ArrayRemoveVal(ByRef arr, ByVal val)
Dim i, j
If IsArray(arr) Then
i = 0 : j = -1
For i = 0 To UBound(arr)
If arr(i) <> val Then
j = j + 1
arr(j) = arr(i)
End If
Next
ReDim Preserve Array(j)
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Removes duplicate items from the array.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ArrayCull(ByRef arr)
Dim i, dict
If IsArray(arr) Then
Set dict = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(arr)
If Not dict.Exists(arr(i)) Then
Call dict.Add(arr(i), arr(i))
End If
Next
arr = dict.Items
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purges null elements from an array.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ArrayPurge(ByRef arr)
Dim i, j
If IsArray(arr) Then
i = 0
j = -1
For i = 0 To UBound(arr)
If Not IsNull(arr(i)) Then
j = j + 1
arr(j) = arr(i)
End If
Next
ReDim Preserve Array(j)
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Find the first occurance of a value in an array
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ArraySearch(ByRef arr, ByVal val)
Dim i
ArraySearch = -1
If IsArray(arr) Then
For i = 0 To UBound(arr)
If arr(i) = val Then
ArraySearch = i
Exit Function
End If
Next
End If
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Sorts the elements in the array.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ArraySort(ByRef arr)
Dim i, j, tmp
If IsArray(arr) Then
For i = UBound(arrShort) - 1 To 0 Step -1
For j = 0 To i
If arr(j) > arr(j + 1) Then
tmp = arr(j + 1)
arr(j + 1) = arr(j)
arr(j) = tmp
End If
Next
Next
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Reverse the order of the elements in the array.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ArrayReverse(ByRef arr)
Dim i, ub, ub2, tmp
ub = UBound(arr)
ub2 = Int(ub / 2)
For i = 0 To ub2
tmp = arr(i)
arr(i) = arr(ub - i)
arr(ub - i) = tmp
Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Dumps the array to the Rhino command window.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ArrayDump(ByVal arr)
Dim i
If IsArray(arr) Then
For i = 0 To UBound(arr)
Call Rhino.Print("Item(" & CStr(i) & ") = " & CStr(arr(i)))
Next
End If
End Sub