VideoPhoto

29 July, 2023

Shapes Based On Equations: Cardioids

Cardioid curve is formed by tracing a point selected on the circumference of a circle, rolling onto another circle of the same radius. Here are two examples of cardioid graphics, one is just a single cardioid curve and the other is presentation of 4 cardioids positioned within the same coordinates.

These kind of graphics can be generated using the VBA macro listed below the two charts.

To use the macro and plot your own cardioids, just copy this code to one of the modules in your workbook sheets and try it with the same or different formatting settings.

Sub CreateCardioidShape()
'Creates Cardioid curve(s)
'In this code, the coordinate values are calculated using equations within the VBA code.

Dim i As Integer, numPoints As Integer
Dim chartObj As ChartObject
Dim oChart As Chart
Dim xValues() As Double, yValues() As Double
Dim x2Values() As Double, y2Values() As Double
Dim x3Values() As Double, y3Values() As Double
Dim x4Values() As Double, y4Values() As Double
'Define the number of data points and calculate X and Y values
numPoints = 3000     'Change as needed
ReDim xValues(1 To numPoints)
ReDim yValues(1 To numPoints)
ReDim x2Values(1 To numPoints)
ReDim y2Values(1 To numPoints)
ReDim x3Values(1 To numPoints)
ReDim y3Values(1 To numPoints)
ReDim x4Values(1 To numPoints)
ReDim y4Values(1 To numPoints)
'Calculate X and Y values using cardioid equations
For i = 1 To numPoints Step 2   'First series (horizontal)
    xValues(i) = (1 - Cos(WorksheetFunction.Radians(i))) * Cos(WorksheetFunction.Radians(i))
    yValues(i) = (1 - Cos(WorksheetFunction.Radians(i))) * Sin(WorksheetFunction.Radians(i))
Next i
For i = 1 To numPoints Step 2   'Second series (vertical)
    y2Values(i) = (1 - Cos(WorksheetFunction.Radians(i))) * Cos(WorksheetFunction.Radians(i))
    x2Values(i) = (1 - Cos(WorksheetFunction.Radians(i))) * Sin(WorksheetFunction.Radians(i))
Next i
For i = 1 To numPoints Step 2   'Third series (horizontal)
    x3Values(i) = -(1 - Cos(WorksheetFunction.Radians(i))) * Cos(WorksheetFunction.Radians(i))
    y3Values(i) = -(1 - Cos(WorksheetFunction.Radians(i))) * Sin(WorksheetFunction.Radians(i))
Next i
For i = 1 To numPoints Step 2   'Fourth series (vertical)
    y4Values(i) = -(1 - Cos(WorksheetFunction.Radians(i))) * Cos(WorksheetFunction.Radians(i))
    x4Values(i) = -(1 - Cos(WorksheetFunction.Radians(i))) * Sin(WorksheetFunction.Radians(i))
Next i
'Create a new chart object
Set chartObj = ActiveSheet.ChartObjects.Add(Top:=10, Left:=100, Width:=600, Height:=600)
Set oChart = chartObj.Chart
oChart.ChartType = xlXYScatter      'Set the chart type to scatter chart
'Set X and Y values for the chart series
    chartObj.Chart.SeriesCollection.NewSeries
    chartObj.Chart.SeriesCollection(1).Values = yValues
    chartObj.Chart.SeriesCollection(1).xValues = xValues
    chartObj.Chart.SeriesCollection.NewSeries
    chartObj.Chart.SeriesCollection(2).Values = y2Values
    chartObj.Chart.SeriesCollection(2).xValues = x2Values
    chartObj.Chart.SeriesCollection.NewSeries
    chartObj.Chart.SeriesCollection(3).Values = y3Values
    chartObj.Chart.SeriesCollection(3).xValues = x3Values
    chartObj.Chart.SeriesCollection.NewSeries
    chartObj.Chart.SeriesCollection(4).Values = y4Values
    chartObj.Chart.SeriesCollection(4).xValues = x4Values
'The code below formats the chart and plot area; can be modified as needed
    chartObj.Activate
    ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
    ActiveChart.SetElement (msoElementPrimaryValueAxisTitleAdjacentToAxis)
    ActiveChart.SetElement (msoElementPrimaryValueGridLinesNone)
    ActiveChart.SetElement (msoElementPrimaryCategoryGridLinesNone)
'Add chart title and title of the axes
    oChart.Axes(xlCategory).HasTitle = True
    oChart.Axes(xlCategory).AxisTitle.Caption = "X values"
    oChart.Axes(xlValue).HasTitle = True
    oChart.Axes(xlValue).AxisTitle.Caption = "Y values"
    oChart.HasTitle = True
    oChart.ChartTitle.Text = "Cardioid"
    oChart.ChartTitle.Select
    With Selection.Font
        .Bold = msoTrue
        .Size = 14
    End With
'Set/change some elements of the chart
    ActiveChart.ChartArea.Select
    With Selection.Format.Line
        .Visible = msoTrue
        .Weight = 0.25
    End With
    ActiveChart.PlotArea.Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 200)
    End With
    ActiveChart.FullSeriesCollection(1).Select
    Selection.MarkerStyle = 8
    Selection.MarkerSize = 5
    Selection.Format.Fill.ForeColor.RGB = RGB(200, 0, 0)
    Selection.Format.Line.Visible = msoFalse
    ActiveChart.FullSeriesCollection(2).Select
    Selection.MarkerStyle = 8
    Selection.MarkerSize = 5
    Selection.Format.Fill.ForeColor.RGB = RGB(0, 200, 0)
    Selection.Format.Line.Visible = msoFalse
    ActiveChart.FullSeriesCollection(3).Select
    Selection.MarkerStyle = 8
    Selection.MarkerSize = 5
    Selection.Format.Fill.ForeColor.RGB = RGB(0, 0, 200)
    Selection.Format.Line.Visible = msoFalse
    ActiveChart.FullSeriesCollection(4).Select
    Selection.MarkerStyle = 8
    Selection.MarkerSize = 5
    Selection.Format.Fill.ForeColor.RGB = RGB(200, 200, 200)
    Selection.Format.Line.Visible = msoFalse
    ActiveChart.PlotArea.Select
    With Selection.Format.Line
        .Visible = msoTrue
        .Weight = 0.25
    End With
    Range("A1").Select
End Sub

 

No comments:

Post a Comment

All comments are held for moderation. I reserve the right to edit, censor, delete and - if necessary - block comments.