I was chatting with an old school friend and he reminded me that we had a few maths lessons where we drew some fantastic, diamond patterns with just a pencil and a ruler.
After some industrious googling I found that drawing these sorts of patterns is commonly referred as curve stitching, which is a form of string art. How to Create Parabolic Curves using Straight Lines gives a nice overview. I thought it’d be good fun to have a go at drawing some of these patterns in Excel so in the next couple of blog posts we’ll build up a ‘String Art’ add-in which does the hard work for us. The add-in is going to be written in Excel 2010 but it should also be compatible with Excel 2007.
For the first version of the add-in we’ll put together some code which can draw a parabolic section:
The first thing that’s clear is that we’re going to be drawing lots and lots of lines. When we draw lines in Excel we have to specify the X and Y coordinates of the start and end points of the line, so the we’ll start by creating a new custom class (Insert > Class Module) called cPoint which can hold the coordinates. Users who reference our add-in (who will be referred to as end-users going forward) are going to need to be able to see the cPoint class so, when you change the class name in the properties window, also change its Instancing property to 2 – PublicNotCreatable.
Option Explicit Private psngX As Single Private psngY As Single Public Property Let X(ByVal sngValue As Single) psngX = sngValue End Property Public Property Get X() As Single X = psngX End Property Public Property Let Y(ByVal sngValue As Single) psngY = sngValue End Property Public Property Get Y() As Single Y = psngY End Property
Looking back again at the picture of the parabolic section, we can see that it has two axes (in red). Each axis has an equal number of evenly distributed points which are joined together using straight lines. The next thing we’re going to need is another custom class module (Insert > Class Module) called cPoints which can hold a collection of points. For now, the intention is for this class to only be accessible within the project so the Instancing of this class should be set to 1 – Private.
Option Explicit Private pcolPoints As Collection Public Sub Add(ByRef Point As cPoint) pcolPoints.Add Point End Sub Public Function Count() As Long Count = pcolPoints.Count End Function 'be able to loop through the collection with For Each Public Function NewEnum() As IUnknown 'Attribute NewEnum.VB_UserMemID = -4 has been set in text editor Set NewEnum = pcolPoints.[_NewEnum] End Function 'default member of the class Public Function Item(ByVal lngIndex As Long) As cPoint 'Attribute Value.VB_UserMemId = 0 has been set in text editor Set Item = pcolPoints(lngIndex) End Function Private Sub Class_Initialize() Set pcolPoints = New Collection End Sub
This class has a NewEnum() method which lets us use a For Each… Next loop on it and the Item() method has been set as the default member which means that we can get to an item in the collection by using syntax such as clsPoints(1) instead of clsPoints.Item(1). To get these two features to work correctly we have to set some procedure-level attributes. These attributes cannot be set in the VBA IDE because they are hidden, so you have to right-click on the class in the Project Explorer window and export the file to a convenient folder. Next delete the class from the project by right-click > remove cPoints and then open Windows Explorer and navigate to the exported .cls file. Open the .cls file using a text editor such as Notepad.exe and then type in the attributes as indicated on the screenshot below:
Save and exit the file, return to the VBA IDE and right-click on the Class Modules folder in your project in the Project Explorer window and import the .cls file again. Once the .cls file has been imported it will look exactly the same as before: you will not be able to see the attributes you added in the text editor.
Next we’re ready to create a class module called cRegularPolygon (Instancing 2 – PublicNotCreatable) which can draw the parabolic section.
Option Explicit 'this describes how the points should be joined together Public Enum RegularPolygonAxisJoinStyle Cobweb = 0 Matrix = 1 Parabolic = 2 End Enum 'this method lets the user draw a polygon section by providing 'the coordinates of the two corner points Public Sub DrawSectionByBothCornerPoints( _ ByRef wstTarget As Worksheet, _ ByRef clsCentrePoint As cPoint, _ ByRef clsCornerPoint1 As cPoint, _ ByRef clsCornerPoint2 As cPoint, _ ByVal lngPointsPerAxis As Long, _ ByVal lngAxisJoinStyle As RegularPolygonAxisJoinStyle, _ Optional ByRef varLineColor As Variant) Dim clsAxis1 As cPoints, clsAxis2 As cPoints 'quick feasibility check If PointsInSamePosition(clsCentrePoint, clsCornerPoint1) Or _ PointsInSamePosition(clsCentrePoint, clsCornerPoint2) Or _ PointsInSamePosition(clsCornerPoint1, clsCornerPoint2) Then Err.Raise 666, "Centre and corner points cannot be in the same position" End If 'calculate the points along each axis Set clsAxis1 = GetLineOfPoints( _ clsStartPoint:=clsCentrePoint, _ clsEndPoint:=clsCornerPoint1, _ lngPointsCount:=lngPointsPerAxis) Set clsAxis2 = GetLineOfPoints( _ clsStartPoint:=clsCentrePoint, _ clsEndPoint:=clsCornerPoint2, _ lngPointsCount:=lngPointsPerAxis) 'draw the axes JoinPointToPoint _ wstTarget:=wstTarget, _ clsPoint1:=clsCentrePoint, _ clsPoint2:=clsCornerPoint1, _ varForeColor:=varLineColor JoinPointToPoint _ wstTarget:=wstTarget, _ clsPoint1:=clsCentrePoint, _ clsPoint2:=clsCornerPoint2, _ varForeColor:=varLineColor 'join the axes together JoinAxesByStyle _ wstTarget:=wstTarget, _ clsAxis1:=clsAxis1, _ clsAxis2:=clsAxis2, _ lngAxisJoinStyle:=lngAxisJoinStyle, _ varLineColor:=varLineColor End Sub 'this method delegates the axis join duty 'depending on the join style Private Sub JoinAxesByStyle( _ ByRef wstTarget As Worksheet, _ ByRef clsAxis1 As cPoints, _ ByRef clsAxis2 As cPoints, _ ByVal lngAxisJoinStyle As RegularPolygonAxisJoinStyle, _ Optional ByRef varLineColor As Variant) If lngAxisJoinStyle = RegularPolygonAxisJoinStyle.Matrix Then AxisMatrixJoin _ wstTarget:=wstTarget, _ clsAxis1:=clsAxis1, _ clsAxis2:=clsAxis2, _ varLineColor:=varLineColor ElseIf lngAxisJoinStyle = RegularPolygonAxisJoinStyle.Parabolic Then AxisParabolicJoin _ wstTarget:=wstTarget, _ clsAxis1:=clsAxis1, _ clsAxis2:=clsAxis2, _ varLineColor:=varLineColor ElseIf lngAxisJoinStyle = RegularPolygonAxisJoinStyle.Cobweb Then AxisCobWebJoin _ wstTarget:=wstTarget, _ clsAxis1:=clsAxis1, _ clsAxis2:=clsAxis2, _ varLineColor:=varLineColor Else Err.Raise 666, "Invalid join type" End If End Sub 'matrix join will join all points on an axis to all points on another axis Private Sub AxisMatrixJoin( _ ByRef wstTarget As Worksheet, _ ByRef clsAxis1 As cPoints, _ ByRef clsAxis2 As cPoints, _ Optional ByRef varLineColor As Variant) Dim clsPoint1 As cPoint, clsPoint2 As cPoint For Each clsPoint1 In clsAxis1 For Each clsPoint2 In clsAxis2 JoinPointToPoint _ wstTarget:=wstTarget, _ clsPoint1:=clsPoint1, _ clsPoint2:=clsPoint2, _ varForeColor:=varLineColor Next clsPoint2 Next clsPoint1 End Sub 'parabolic join will join points on an axis by reverse position, starting from the 2nd point Private Sub AxisParabolicJoin( _ ByRef wstTarget As Worksheet, _ ByRef clsAxis1 As cPoints, _ ByRef clsAxis2 As cPoints, _ Optional ByRef varLineColor As Variant) Const lngSTART_POINT As Long = 2 Dim p1 As Long If clsAxis1.Count <> clsAxis2.Count Then Err.Raise 666, "Can only parabolic join if points counts are equal" Else For p1 = lngSTART_POINT To clsAxis1.Count JoinPointToPoint _ wstTarget:=wstTarget, _ clsPoint1:=clsAxis1(p1), _ clsPoint2:=clsAxis2(clsAxis2.Count - p1 + lngSTART_POINT), _ varForeColor:=varLineColor Next p1 End If End Sub 'cobweb join will join points on two axes which have the same position Private Sub AxisCobWebJoin( _ ByRef wstTarget As Worksheet, _ ByRef clsAxis1 As cPoints, _ ByRef clsAxis2 As cPoints, _ Optional ByRef varLineColor As Variant) Dim p1 As Long If clsAxis1.Count <> clsAxis2.Count Then Err.Raise 666, "Can only cobweb join if points counts are equal" Else For p1 = 1 To clsAxis1.Count JoinPointToPoint _ wstTarget:=wstTarget, _ clsPoint1:=clsAxis1(p1), _ clsPoint2:=clsAxis2(p1), _ varForeColor:=varLineColor Next p1 End If End Sub 'this method calculates the positions of 'evenly dispersed points along a line - 'start and end points are included in the point count Private Function GetLineOfPoints( _ ByRef clsStartPoint As cPoint, _ ByRef clsEndPoint As cPoint, _ ByVal lngPointsCount As Long) As cPoints Dim sngXDelta As Single, sngYDelta As Single Dim p As Long Dim clsPoint As cPoint 'get change in X and Y per point sngXDelta = (clsEndPoint.X - clsStartPoint.X) / (lngPointsCount - 1) sngYDelta = (clsEndPoint.Y - clsStartPoint.Y) / (lngPointsCount - 1) Set GetLineOfPoints = New cPoints 'get the coordinates of the points along the line For p = 0 To lngPointsCount - 1 Set clsPoint = New cPoint clsPoint.X = clsStartPoint.X + p * sngXDelta clsPoint.Y = clsStartPoint.Y + p * sngYDelta GetLineOfPoints.Add clsPoint Next p End Function 'this method draws a line between two points Private Sub JoinPointToPoint( _ ByRef wstTarget As Worksheet, _ ByRef clsPoint1 As cPoint, _ ByRef clsPoint2 As cPoint, _ Optional ByRef varForeColor As Variant) Dim shp As Shape Set shp = wstTarget.Shapes.AddLine _ (BeginX:=clsPoint1.X, _ BeginY:=clsPoint1.Y, _ EndX:=clsPoint2.X, _ EndY:=clsPoint2.Y) If Not IsMissing(varForeColor) Then shp.Line.ForeColor.RGB = varForeColor End If End Sub 'determines if two points are in the same position Private Function PointsInSamePosition( _ ByRef clsPoint1 As cPoint, _ ByRef clsPoint2 As cPoint) As Boolean If clsPoint1.X = clsPoint2.X Then PointsInSamePosition = (clsPoint1.Y = clsPoint2.Y) End If End Function
In addition to the ‘parabolic’ join we saw earlier, there are a couple of other very obvious patterns we could use to join the points on each axis. The ‘cobweb’ and ‘matrix’ join styles have also been catered for in this first version of the add-in.
The method which the end users can call to draw the section is DrawSectionByBothCornerPoints(). The pieces of information the end-users have to provide are:
wstTarget: The worksheet the section should be drawn on
clsCentrePoint: A cPoint object which holds the coordinates of the starting point of both axes
clsCornerPoint1: A cPoint object which holds the coordinates of the end point of the first axis
clsCornerPoint2: A cPoint object which holds the coordinates of the end point of the second axis
lngPointsPerAxis: How many evenly dispersed points there are on each axis. This includes the start and end points.
lngAxisJoinStyle: How the points on the axes should be joined together: Cobweb, Matrix or Parabolic
The code then calculates the points, draws the axes and then joins together the points on the axes. The feasibility checks and error raising are residual from where the code was written and tested – this is all a bit of fun so they’re not intended to be of industrial strength.
The GetLineOfPoints() method is the one used to create a cPoints object which holds a collection of cPoint objects along an axis. Note that the start and end points are included in the total count.
The JoinPointToPoint() method draws a line between two cPoint objects. There’s an optional parameter which will let the end-user specify the colour.
The PointsInSamePosition() method is a simple check to see if two cPoint objects have the same coordinates. I found that when I was writing the add-in and testing code against it, I accidentally gave two points the same coordinates – so this check found its way into the code.
That’s it, the first version of the add-in is written. Well, almost. The final consideration is that VBA custom class objects can not be directly created from outside of a project. We have to provide some functions which will allow the end-users to instantiate them. Add a standard code module (Insert > Module) called mInterface and paste in this code:
Option Explicit 'these functions allow outside projects to create instances of 'this project's classes Public Function CreateRegularPolygon() As cRegularPolygon Set CreateRegularPolygon = New cRegularPolygon End Function Public Function CreatePoint() As cPoint Set CreatePoint = New cPoint End Function
In the Project Explorer window, select the project (in bold) and in the properties window change its name from VBAProject to StringArt, return to the Excel UI, remove any excess worksheets (so there’s only 1 left) and save the workbook in a folder of your choice as a macro-enabled file called String Art v1.0.xlsm. Then go to File > Save As and save the file again, but this time save as type Excel Add-In. When you pick Excel Add-In (*.xlam) from the dropdown box, Excel will (in my view, annoyingly) change the folder location to your add-ins folder. You can save the add-in there or wherever you like, so long as you remember its location.
In the next post we’ll have a go at using the add-in to draw some string art.