array modification

[ben.doherty]

hi,
I have a 2D array of nodes that gets stretched around.

I want to make it so that if it gets stretched to the point that the inter-node distance gets too high it inserts a new row of noses into the middle of the array.

I've been making a new array and putting the second half of the old array into that, then ReDim-ing the first array to be 1 bigger than it was before, then putting the old stuff back into the array and making the new nodes values the average of their neighbours.

There are two problems with this approach though, one is that it doesn't work,(errors abound) and the second is that it's not very elegant!

What I'd really like to be ale to say array.insert, but I think that's a bit beyond vba, so I think the most elegant way to do it would be to copy (split) the contents of the current array into two new ones, delete the old one, and redeclare it, then fill it up from the two temporary arrays.

Does anyone know if this is possible? I can't find anything about deleting arrays in the help files.

[ben.doherty]

I've cracked the way of deleting the array.
I just need to redim without preserve, then I can change as many dimensions as I like

[Anonymous]

Take a look a this. It is not the code you are looking for, but this what I created when it was explained to me that you need to create a new array, passing everything, but what you do not want, from the old array to the new one, then deleting the old array and using the first arrays name again and copying the second array back to the first one.

Dim HCircles() As typHCircles
Dim HCircles2() As typHCircles2
Dim NewHCircles2() As typHCircles2

Public Type typHCircles
CHandle As String
CDia As Double
CCenter0 As Double
CCenter1 As Double
CCenter2 As Double
CNorm0 As Double
CNorm1 As Double
CNorm2 As Double
End Type


Public Type typHCircles2
CHandle2 As String
CDia2 As Double
CCenter20 As Double
CCenter21 As Double
CCenter22 As Double
CNorm20 As Double
CNorm21 As Double
CNorm22 As Double
End Type


code for deleting all dupe circles
setLines.Clear
setLines.Select acSelectionSetAll
circlesFound2 = -1

For Each Ent In setLines
If Ent.ObjectName = "AcDbCircle" Then
If (Ent.Layer) = "CircleHold2" Then
Set NewCircle2 = Ent


circlesFound2 = circlesFound2 + 1
ReDim Preserve HCircles2(circlesFound2)
HCircles2(circlesFound2).CHandle2 = NewCircle2.Handle
HCircles2(circlesFound2).CCenter20 = Abs(NewCircle2.center(0))
HCircles2(circlesFound2).CCenter21 = Abs(NewCircle2.center(1))
HCircles2(circlesFound2).CCenter22 = Abs(NewCircle2.center(2))

HCircles2(circlesFound2).CNorm20 = Abs(NewCircle2.Normal(0))
HCircles2(circlesFound2).CNorm21 = Abs(NewCircle2.Normal(1))
HCircles2(circlesFound2).CNorm22 = Abs(NewCircle2.Normal(2))

HCircles2(circlesFound2).CDia2 = Abs(NewCircle2.Diameter)

End If
End If
Next

'the array is now populated, this deletes the dupes
For Each Ent In setLines
If Ent.ObjectName = "AcDbCircle" Then
If (Ent.Layer) = "CircleHold2" Then
Set dupeCircleA = Ent



NewNumber = circlesFound2
Do Until NewNumber = -1


If (dEquals(dupeCircleA.center(0), HCircles2(NewNumber).CCenter20)) And _
(dEquals(dupeCircleA.center(1), HCircles2(NewNumber).CCenter21)) And _
(dEquals(dupeCircleA.center(2), HCircles2(NewNumber).CCenter22)) And _
(dEquals(dupeCircleA.Diameter, HCircles2(NewNumber).CDia2)) And _
dupeCircleA.Handle <> HCircles2(NewNumber).CHandle2 And _
dupeCircleA.Normal(2) = 1 Then




LookingforIt = UBound(HCircles2)
Do Until LookingforIt = -1
If dupeCircleA.Handle = HCircles2(LookingforIt).CHandle2 Then
RemoveIndex = LookingforIt
GoTo MynextMove
End If
LookingforIt = LookingforIt - 1
Loop
MynextMove:
NewNumber2 = UBound(HCircles2)
ReDim NewHCircles2(NewNumber2) As typHCircles2
NewHCircles2 = HCircles2
Erase HCircles2()

NewNumber = -1

For I = 0 To NewNumber2
If I <> RemoveIndex Then
NewNumber = NewNumber + 1
ReDim Preserve HCircles2(NewNumber)
HCircles2(NewNumber) = NewHCircles2(I)
End If
Next I

dupeCircleA.Delete
circlesFound2 = NewNumber
GoTo skiptohere
End If

NewNumber = NewNumber - 1
Loop

End If
End If
skiptohere:
Next

[Anonymous]

You may need these functions to play around with the code above


Public Function dEquals(ByRef A As Variant, ByRef b As Variant) As Boolean

If (Abs(A - b) < 0.0001) Then
dEquals = True
Else
dEquals = False
End If

End Function