Monday, January 9, 2017

Turtlegraphics on an Excel xy scatter chart

I was making an xy chart and discovered that if I had gaps in the data, that they would appear as disconnected lines in the chart.

So then I could make vector graphics on a chart.

And do some turtle graphics.


First, make a blank workbook and then insert a xy scatter chart, set the data source as A1:B200, and make sure that gaps will appear for empty lines.

Then have this code in a VBA Module:

Dim xpos, ypos, angle, pencolor As Single
Dim penstatus As Integer
Dim pi As Single
Dim rowpos As Integer



Sub pc(acolor)
pencolor = acolor
End Sub

Sub initturtle()
rowpos = 1
pi = 3.14
xpos = 0
ypos = 0
angle = 0
pencolor = RGB(255, 0, 0)
penstatus = 1
End Sub


Sub pu()
 penstatus = 0
End Sub

Sub pd()
 penstatus = 1
End Sub

Sub rt(x)
  angle = angle - x
End Sub

Sub lt(x)
  rt -x
End Sub

Sub colorpoint(rowpos)
      ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(rowpos).Format.Line.ForeColor.RGB = pencolor
End Sub

Sub movepos(newxpos, newypos)
  
  oldxpos = xpos
  oldypos = ypos  
  If penstatus = 1 Then
    If (rowpos = 1) Then
      ActiveSheet.Cells(rowpos, 1) = oldxpos
      ActiveSheet.Cells(rowpos, 2) = oldypos
      colorpoint rowpos
      rowpos = rowpos + 1
      ActiveSheet.Cells(rowpos, 1) = newxpos
      ActiveSheet.Cells(rowpos, 2) = newypos
      colorpoint rowpos
   ElseIf (ActiveSheet.Cells(rowpos, 1) = oldxpos) And (ActiveSheet.Cells(rowpos, 2) = oldypos) Then
      rowpos = rowpos + 1
      colorpoint rowpos
      ActiveSheet.Cells(rowpos, 1) = newxpos
      ActiveSheet.Cells(rowpos, 2) = newypos
      'rowpos = rowpos + 1
    Else
      rowpos = rowpos + 1
      colorpoint rowpos
      ActiveSheet.Cells(rowpos, 1) = Empty
      ActiveSheet.Cells(rowpos, 2) = Empty
      rowpos = rowpos + 1
      colorpoint rowpos
      ActiveSheet.Cells(rowpos, 1) = oldxpos
      ActiveSheet.Cells(rowpos, 2) = oldypos
      rowpos = rowpos + 1
      colorpoint rowpos
      ActiveSheet.Cells(rowpos, 1) = newxpos
      ActiveSheet.Cells(rowpos, 2) = newypos
  End If
  End If
   xpos = newxpos
   ypos = newypos
End Sub

Sub fd(x)
  newxpos = xpos + Cos(angle / 360 * 2 * pi) * x
  newypos = ypos + Sin(angle / 360 * 2 * pi) * x
  movepos newxpos, newypos
  
End Sub
Sub bk(x)
  fd -x
End Sub


sub test1
Call initturtle: For j = 1 To 6: For i = 1 To 20: lt 360 / 20: fd 20: Next i: rt 60: Next j
end sub

sub test2
Call initturtle: For i = 1 To 50: Call pu: movepos Rnd() * 50, Rnd() * 50: Call pd: movepos Rnd() * 50, Rnd() * 50: pc RGB(Rnd() * 255, Rnd() * 255, Rnd() * 255): Next i
end sub



If I do this from the immediate window:

pd : fd 20

for some reason I get an error (it doesn't like functions without parameters followed with a colon)

so I have to use

call pd: fd 20

to get them all on one line.

You can put for loops in the immediate window as well:

initturtle:for i = 1 to 180: call pu : rt 1 : fd 5: call pd : rt 1 : fd 5 : next i

I have yet to add a couple of functions, but this is proof of concept.

Oh yeah, to clear the graphics, just select column A and B and clear the contents.

I was thinking I could add the "turtle" by creating another data series in the chart.

It seems to work in libreoffice calc if I just comment out the line in colorpoint (but then you don't get the color you want):

Sub colorpoint(rowpos)
'ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(rowpos).Format.Line.ForeColor.RGB = pencolor
End Sub

sub test1
Call initturtle: For j = 1 To 6: For i = 1 To 20: lt 360 / 20: fd 20: Next i: rt 60: Next j
end sub






sub test2
Call initturtle: For i = 1 To 50: Call pu: movepos Rnd() * 50, Rnd() * 50: Call pd: movepos Rnd() * 50, Rnd() * 50: pc RGB(Rnd() * 255, Rnd() * 255, Rnd() * 255): Next i
end sub



No comments:

Post a Comment