Optically Illusory

I came across a charming little optical brain-bender a while back, and wondered what would be needed to reproduce it in Excel/VBA. Not much, as it transpired (see below). I’ve golfed the code somewhat for brevity. Dump the following in an empty VBA module and run “DrawIllusion”…

Private pi As Single
Public Sub DrawIllusion()
Dim shp, c
pi = WorksheetFunction.pi()
ActiveWindow.DisplayGridlines = False
For Each shp In ActiveSheet.Shapes: shp.Delete: Next
NewShape 0, 0, 420, 0, vbWhite
For c = 1 To 4: DrawACircle 200, 200, 60 + (c - 1) * 40, 15, 5, -20 + (c Mod 2) * 40: Next
End Sub

Private Sub DrawACircle(x, y, r, side, gap, rotationOffset)
Dim numSquares, i, angle, shp
numSquares = NumToDraw(r, side, gap)
For i = 1 To numSquares
angle = (i - 1) * 2 * pi / numSquares
Set shp = NewShape(x + r * Cos(angle), y + r * Sin(angle), side, angle * 180# / pi, IIf(i Mod 2 = 1, vbBlack, vbWhite))
shp.Rotation = shp.Rotation + rotationOffset
Next
End Sub

Private Function NumToDraw(r, side, gap)
NumToDraw = Int(2 * pi * r / (side + gap))
NumToDraw = NumToDraw - NumToDraw Mod 2
End Function

Private Function NewShape(x, y, side, rot, color)
Set NewShape = ActiveSheet.Shapes.AddShape(msoShapeRectangle, x, y, side, side)
NewShape.Rotation = rot
NewShape.Line.ForeColor.RGB = color
NewShape.Line.Weight = 1
NewShape.Fill.ForeColor.RGB = RGB(128, 128, 128)
End Function
1. dougaj4 says: