String Art Add-In v1.0

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.

cPoint

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.

cPoints

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.

cRegularPolygon

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:

mInterface

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.

Advertisements

About Colin Legg

RAD Developer Microsoft MVP - Excel 2009 - 2014
This entry was posted in Microsoft Excel, Microsoft Office and tagged , , , . Bookmark the permalink.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s