String Art Add-In v1.1

In the String Art Add-In v1.0 we put together a class called cRegularPolygon which exposes a DrawSectionByBothCornerPoints() method to allow an end-user to draw a polygon section. This method works very well but it’s a bit cumbersome for the end-user to have to calculate the centre and end points of the axes so, for the next installment of the add-in, we’re going to add a new method which will allow them to provide a more convenient set of information to draw the section. Ideally we would have a single method name such as DrawSection() into which the end users could pass different parameter sets but, since VBA doesn’t support overloading, we have to create separate methods with different names. Here’s the full code for this version of the add-in, some release notes and examples.

Edit 11th December: I just noticed that when I submitted the post, WordPress parsed a number of characters in the code so that it would not compile. For example, " had been parsed as ". I’ve fixed it now and while I was doing it I took the opportunity to refactor part of the code so that it’s slightly cleaner to use.

String Art Add-In v1.1 Downloadable Version

This version of the add-in can be downloaded from here. To use the add-in, follow the instructions I gave for the v1.0 release.

String Art Add-In v1.1 Code

Module: 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

Module: mMath

Option Explicit

Public Function Pi() As Double
    Pi = 3.14159265358979
End Function

Public Function RadiansInCircle() As Double
    RadiansInCircle = 2 * Pi
End Function

Public Function RadiansInSemiCircle() As Double
    RadiansInSemiCircle = Pi
End Function

Public Function RadiansInRightAngle() As Double
    RadiansInRightAngle = Pi / 2
End Function

Public Function ConvertDegreesToRadians(ByVal dblDegrees As Double) As Double
    ConvertDegreesToRadians = dblDegrees / 180 * Pi
End Function

Class Module: cRegularPolygon

  • Instancing: PublicNotCreatable
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)

    '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

    'draw the section
    DrawAndJoinAxesByStyle wstTarget:=wstTarget, _
                            clsCentrePoint:=clsCentrePoint, _
                            clsCornerPoint1:=clsCornerPoint1, _
                            clsCornerPoint2:=clsCornerPoint2, _
                            lngPointsPerAxis:=lngPointsPerAxis, _
                            lngAxisJoinStyle:=lngAxisJoinStyle, _
                            varLineColor:=varLineColor

End Sub

'this method lets the user draw a polygon section by providing
'theta, the angle between the two axes
'rho, the angle of the first axis (clockwise) from vertical
'and the length of the axes
Public Sub DrawSectionByAxisLength( _
            ByRef wstTarget As Worksheet, _
            ByRef clsCentrePoint As cPoint, _
            ByVal dblTheta As Double, _
            ByVal sngAxisLength As Single, _
            ByVal lngPointsPerAxis As Long, _
            ByVal lngAxisJoinStyle As RegularPolygonAxisJoinStyle, _
            Optional ByVal dblRho As Double = 0, _
            Optional ByRef varLineColor As Variant)

    Dim clsCornerPoint1 As cPoint, clsCornerPoint2 As cPoint

    'quick feasibility check
    If sngAxisLength <= 0 Then Err.Raise 666, "Axis length must be greater than 0"

    'determine end point of axis1
    Set clsCornerPoint1 = GetCornerPointFromAngleAndLength( _
                            clsCentrePoint:=clsCentrePoint, _
                            dblAngle:=dblRho, _
                            sngLength:=sngAxisLength)

    'determine the end point of axis2
    Set clsCornerPoint2 = GetCornerPointFromAngleAndLength( _
                            clsCentrePoint:=clsCentrePoint, _
                            dblAngle:=dblRho + dblTheta, _
                            sngLength:=sngAxisLength)

    'draw the section
    DrawAndJoinAxesByStyle wstTarget:=wstTarget, _
                            clsCentrePoint:=clsCentrePoint, _
                            clsCornerPoint1:=clsCornerPoint1, _
                            clsCornerPoint2:=clsCornerPoint2, _
                            lngPointsPerAxis:=lngPointsPerAxis, _
                            lngAxisJoinStyle:=lngAxisJoinStyle, _
                            varLineColor:=varLineColor

End Sub

'this method draws the axes
'and delegates the axis join duty
'depending on the join style
Private Sub DrawAndJoinAxesByStyle( _
            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

    'calculate the join 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
    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

'calculates the corner point coordinates given
'the position of the centrepoint, the angle of the axis
'and the length of the axis
Private Function GetCornerPointFromAngleAndLength( _
            ByRef clsCentrePoint As cPoint, _
            ByVal dblAngle As Double, _
            ByVal sngLength As Single) As cPoint

    Set GetCornerPointFromAngleAndLength = New cPoint

    GetCornerPointFromAngleAndLength.X = clsCentrePoint.X + sngLength * Sin(dblAngle)
    GetCornerPointFromAngleAndLength.Y = clsCentrePoint.Y - sngLength * Cos(dblAngle)

End Function

'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

Class Module: cPoint

  • Instancing: 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

Class Module: cPoints

  • Instancing: Private
  • See instructions here on how to set the procedure level attributes
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

Release Notes

DrawSectionByAxisLength

The new DrawSectionByAxisLength()  method allows users to draw the section by defining the coordinates of the centre point, the length (r) of the axes, the angle (Theta) between the axes and the angle (Rho) of the first axis clockwise from 12 o’clock. Theta and Rho must be specified in radians, not degrees.

DrawSectionByAxisLengthAngles

Trigonometry is then used within the class to calculate the axis end point coordinates. The general formulae to calculate the x and y coordinates of the end points are:

EndX = CentreX +  r * Sin(Angle)
EndY = CentreY - r * Cos(Angle)

The reason the change in Y is subtracted is because Y coordinates  increase from top to bottom on an Excel worksheet.

mMath

The VBA trigonometry functions work with radians rather than degrees. It’s been at least fifteen years since I last did any trigonometry and picturing angles in radians just doesn’t come naturally to me. I know there are 90 degrees in a right-angle, but it’s not instinctive for me to say that there are Pi/2 radians in a right-angle. I’m probably not the only person out there who thinks this way, so I figured that it would be useful to have some methods to help ‘degree orientated’ end-users work in radians.

Examples

I decided to have a go at moving a parabolic polygon section around an Excel sheet and, with a few carefully placed DoEvents commands, the output isn’t too shabby. I never had moving shapes in mind when I built the add-in so the implementation is a little clunky, but nonetheless works. If string art animation proves to be popular then I’ll implement it properly in a future release.

Here’s a section bouncing between two walls:

And here’s a section with a rotating axis:

And, finally, four rotating axes with a bit of colour:

Here’s the code for them:

Option Explicit

Sub Animation1()

    Const lngPOINTS_PER_AXIS As Long = 15
    Const sngAXIS_LENGTH As Single = 60

    Dim clsRegPol As StringArt.cRegularPolygon
    Dim clsCentrePoint As StringArt.cPoint

    Dim sngStartX As Single, sngStartY As Single
    Dim sngLeftWallX As Single, sngRightWallX As Single
    Dim dblTheta As Double, dblRho As Double
    Dim X As Double
    Dim wstTarget As Worksheet

    Set wstTarget = Worksheets("Sheet1")

    With wstTarget
        'clear previous run
        .DrawingObjects.Delete

        'boundaries
        With .Range("A1")
            sngLeftWallX = .Left + .Width
        End With
        sngRightWallX = .Range("F1").Left

        'start point coordinates
        With .Range("D5")
            sngStartX = .Left
            sngStartY = .Top
        End With
    End With

    'start in the middle
    Set clsCentrePoint = StringArt.CreatePoint
    clsCentrePoint.X = sngStartX
    clsCentrePoint.Y = sngStartY

    'draw our section and group the lines so we can move them together
    Set clsRegPol = StringArt.CreateRegularPolygon

    dblRho = StringArt.RadiansInRightAngle / 2
    dblTheta = StringArt.RadiansInRightAngle

    clsRegPol.DrawSectionByAxisLength _
                            wstTarget:=wstTarget, _
                            clsCentrePoint:=clsCentrePoint, _
                            dblTheta:=dblTheta, _
                            sngAxisLength:=sngAXIS_LENGTH, _
                            lngPointsPerAxis:=lngPOINTS_PER_AXIS, _
                            lngAxisJoinStyle:=Parabolic, _
                            dblRho:=dblRho

    wstTarget.DrawingObjects.Group

    'move the shape to the left wall
    For X = clsCentrePoint.X * 10 To sngLeftWallX * 10 Step -1
        DoEvents
        wstTarget.Shapes(1).Left = X / 10
        DoEvents
    Next X

    'collapse the shape
    clsCentrePoint.X = sngLeftWallX
    For dblTheta = StringArt.RadiansInRightAngle To _
                    StringArt.RadiansInSemiCircle Step StringArt.Pi / 400
        DoEvents
        wstTarget.DrawingObjects.Delete
        dblRho = (StringArt.Pi - dblTheta) / 2

        clsRegPol.DrawSectionByAxisLength _
                            wstTarget:=wstTarget, _
                            clsCentrePoint:=clsCentrePoint, _
                            dblTheta:=dblTheta, _
                            sngAxisLength:=sngAXIS_LENGTH, _
                            lngPointsPerAxis:=lngPOINTS_PER_AXIS, _
                            lngAxisJoinStyle:=Parabolic, _
                            dblRho:=dblRho
        DoEvents
    Next dblTheta

    'restore the shape facing the other way
    For dblTheta = StringArt.RadiansInSemiCircle To _
                    StringArt.RadiansInRightAngle Step - StringArt.Pi / 400
        DoEvents
        wstTarget.DrawingObjects.Delete
        clsCentrePoint.X = sngLeftWallX + Sin(StringArt.Pi / 2 - dblTheta / 2) * sngAXIS_LENGTH
        dblRho = (3 / 2 * StringArt.Pi) - dblTheta / 2

        clsRegPol.DrawSectionByAxisLength _
                            wstTarget:=wstTarget, _
                            clsCentrePoint:=clsCentrePoint, _
                            dblTheta:=dblTheta, _
                            sngAxisLength:=sngAXIS_LENGTH, _
                            lngPointsPerAxis:=lngPOINTS_PER_AXIS, _
                            lngAxisJoinStyle:=Parabolic, _
                            dblRho:=dblRho
        DoEvents
    Next dblTheta

    'move the shape to the right wall
    wstTarget.DrawingObjects.Group
    For X = clsCentrePoint.X * 10 To sngRightWallX * 10
        DoEvents
        wstTarget.Shapes(1).Left = X / 10 - wstTarget.Shapes(1).Width
        DoEvents
    Next X

    'collapse the shape
    clsCentrePoint.X = sngRightWallX
    For dblTheta = StringArt.Pi / 2 To StringArt.Pi Step StringArt.Pi / 400
        DoEvents
        wstTarget.DrawingObjects.Delete
        dblRho = (3 / 2 * StringArt.Pi) - dblTheta / 2
        clsRegPol.DrawSectionByAxisLength _
                            wstTarget:=wstTarget, _
                            clsCentrePoint:=clsCentrePoint, _
                            dblTheta:=dblTheta, _
                            sngAxisLength:=sngAXIS_LENGTH, _
                            lngPointsPerAxis:=lngPOINTS_PER_AXIS, _
                            lngAxisJoinStyle:=Parabolic, _
                            dblRho:=dblRho
        DoEvents
    Next dblTheta

    'restore the shape facing the other way
    For dblTheta = StringArt.Pi To StringArt.Pi / 2 Step - StringArt.Pi / 400
        DoEvents
        wstTarget.DrawingObjects.Delete
        clsCentrePoint.X = sngRightWallX - Sin(StringArt.Pi / 2 - dblTheta / 2) * sngAXIS_LENGTH
        dblRho = (StringArt.Pi - dblTheta) / 2
        clsRegPol.DrawSectionByAxisLength _
                            wstTarget:=wstTarget, _
                            clsCentrePoint:=clsCentrePoint, _
                            dblTheta:=dblTheta, _
                            sngAxisLength:=sngAXIS_LENGTH, _
                            lngPointsPerAxis:=lngPOINTS_PER_AXIS, _
                            lngAxisJoinStyle:=Parabolic, _
                            dblRho:=dblRho
        DoEvents
    Next dblTheta

    'move the shape to the start point
    wstTarget.DrawingObjects.Group
    For X = clsCentrePoint.X * 10 To sngStartX * 10 Step -1
        DoEvents
        wstTarget.Shapes(1).Left = X / 10
        DoEvents
    Next X

End Sub
Option Explicit

Sub Animation2()

    Const sngAXIS_LENGTH As Single = 80
    Const lngPOINTS_PER_AXIS As Long = 10
    Const dblRho As Double = 0
    Const lngMAX_ROTATIONS As Double = 5

    Dim clsCentrePoint As StringArt.cPoint
    Dim clsRegPol As StringArt.cRegularPolygon
    Dim dblTheta As Double
    Dim lngRotation As Long
    Dim wstTarget As Worksheet

    Set wstTarget = Worksheets("Sheet1")

    'centre point coordinates
    Set clsCentrePoint = StringArt.CreatePoint

    With wstTarget
        'clear previous run
        .DrawingObjects.Delete

        With .Range("C7")
            clsCentrePoint.X = .Left
            clsCentrePoint.Y = .Top
        End With
    End With

    'draw our polygon and group the lines so we can move them together
    Set clsRegPol = StringArt.CreateRegularPolygon

    For lngRotation = 1 To lngMAX_ROTATIONS
        For dblTheta = 0 To 2 * StringArt.Pi Step StringArt.Pi / 180
            DoEvents
            wstTarget.DrawingObjects.Delete
            clsRegPol.DrawSectionByAxisLength _
                        wstTarget:=wstTarget, _
                        clsCentrePoint:=clsCentrePoint, _
                        dblTheta:=dblTheta, _
                        sngAxisLength:=sngAXIS_LENGTH, _
                        lngPointsPerAxis:=lngPOINTS_PER_AXIS, _
                        lngAxisJoinStyle:=Parabolic, _
                        dblRho:=dblRho, _
                        varLineColor:=CVar(RGB(0, 0, 0))
            DoEvents
        Next dblTheta
    Next lngRotation

End Sub
Option Explicit

Sub Animation3()

    Const sngAXIS_LENGTH As Single = 80
    Const lngPOINTS_PER_AXIS As Long = 10
    Const dblRho As Double = 0
    Const lngMAX_ROTATIONS As Double = 5

    Dim dblTheta As Double
    Dim clsCentrePoint As StringArt.cPoint
    Dim clsRegPol As StringArt.cRegularPolygon
    Dim lngRotation As Long
    Dim varLineColor As Variant
    Dim wstTarget As Worksheet

    Set wstTarget = Worksheets("Sheet1")

    'centre point coordinates
    Set clsCentrePoint = StringArt.CreatePoint

    With wstTarget
        'clear previous run
        .DrawingObjects.Delete

        With .Range("C7")
            clsCentrePoint.X = .Left
            clsCentrePoint.Y = .Top
        End With
    End With

    'draw our polygon and group the lines so we can move them together
    Set clsRegPol = StringArt.CreateRegularPolygon

    varLineColor = CVar(RGB(230, 253, 95))

    For lngRotation = 1 To lngMAX_ROTATIONS

        For dblTheta = 0 To 2 * StringArt.Pi Step StringArt.Pi / 180
            DoEvents
            wstTarget.DrawingObjects.Delete

            clsRegPol.DrawSectionByAxisLength _
                        wstTarget:=wstTarget, _
                        clsCentrePoint:=clsCentrePoint, _
                        dblTheta:=dblTheta, _
                        sngAxisLength:=sngAXIS_LENGTH, _
                        lngPointsPerAxis:=lngPOINTS_PER_AXIS, _
                        lngAxisJoinStyle:=Parabolic, _
                        dblRho:=dblRho, _
                        varLineColor:=varLineColor

            clsRegPol.DrawSectionByAxisLength _
                        wstTarget:=wstTarget, _
                        clsCentrePoint:=clsCentrePoint, _
                        dblTheta:=-dblTheta, _
                        sngAxisLength:=sngAXIS_LENGTH, _
                        lngPointsPerAxis:=lngPOINTS_PER_AXIS, _
                        lngAxisJoinStyle:=Parabolic, _
                        dblRho:=dblRho, _
                        varLineColor:=varLineColor

            If dblTheta > StringArt.Pi Then
                clsRegPol.DrawSectionByAxisLength _
                        wstTarget:=wstTarget, _
                        clsCentrePoint:=clsCentrePoint, _
                        dblTheta:=dblTheta - StringArt.Pi, _
                        sngAxisLength:=sngAXIS_LENGTH, _
                        lngPointsPerAxis:=lngPOINTS_PER_AXIS, _
                        lngAxisJoinStyle:=Parabolic, _
                        dblRho:=dblRho, _
                        varLineColor:=varLineColor

                clsRegPol.DrawSectionByAxisLength _
                        wstTarget:=wstTarget, _
                        clsCentrePoint:=clsCentrePoint, _
                        dblTheta:=-dblTheta + StringArt.Pi, _
                        sngAxisLength:=sngAXIS_LENGTH, _
                        lngPointsPerAxis:=lngPOINTS_PER_AXIS, _
                        lngAxisJoinStyle:=Parabolic, _
                        dblRho:=dblRho, _
                        varLineColor:=varLineColor
            End If

            If dblTheta < StringArt.Pi Then
                clsRegPol.DrawSectionByAxisLength _
                        wstTarget:=wstTarget, _
                        clsCentrePoint:=clsCentrePoint, _
                        dblTheta:=dblTheta + StringArt.Pi, _
                        sngAxisLength:=sngAXIS_LENGTH, _
                        lngPointsPerAxis:=lngPOINTS_PER_AXIS, _
                        lngAxisJoinStyle:=Parabolic, _
                        dblRho:=dblRho, _
                        varLineColor:=varLineColor

                clsRegPol.DrawSectionByAxisLength _
                        wstTarget:=wstTarget, _
                        clsCentrePoint:=clsCentrePoint, _
                        dblTheta:=-dblTheta - StringArt.Pi, _
                        sngAxisLength:=sngAXIS_LENGTH, _
                        lngPointsPerAxis:=lngPOINTS_PER_AXIS, _
                        lngAxisJoinStyle:=Parabolic, _
                        dblRho:=dblRho, _
                        varLineColor:=varLineColor
            End If

            DoEvents
        Next dblTheta
    Next lngRotation

End Sub

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