Option Explicit
Rem This example creates a Sirpinski fractal.
' The fractal pattern is created by taking each straight line segment
'
'              ---------------
'
' and replacing it with a set of 5 segments (each of length equal to
' 1/3 the length of the original segment
'
'                   -----
'                   |   |
'                   |   |
'              -----     -----
'


Private Sub DoSierp_Click()
Dim appObj As New Illustrator.Application
Dim docObj As Illustrator.Document
Dim groupObj As Illustrator.GroupItem

Set docObj = appObj.Documents.Add


Rem set default properties for the lines that we are going to create
docObj.DefaultFilled = False
docObj.DefaultStroked = True
docObj.DefaultStrokeWidth = 1#
docObj.DefaultStrokeColor = docObj.Swatches("Camouflage").Color

Rem create the initial lines
Dim PointList() As Double
Dim Points As Integer
Points = 4
ReDim PointList(Points, 1)
PointList(0, 0) = 100
PointList(0, 1) = 100
PointList(1, 0) = 400
PointList(1, 1) = 100
PointList(2, 0) = 400
PointList(2, 1) = 400
PointList(3, 0) = 100
PointList(3, 1) = 400
PointList(4, 0) = 100
PointList(4, 1) = 100
Dim NewPointList() As Double


Dim StartX As Double
Dim StartY As Double
Dim EndX As Double
Dim EndY As Double
Dim level, NewPoints, i As Integer
Dim DeltaX, Deltay, Delta As Single
For level = 0 To 2
    ' delete the previous level's display
    If (Not (groupObj Is Nothing)) Then
        docObj.GroupItems.Remove groupObj
        Set groupObj = Nothing
    End If
    
    Rem create a group that will hold this level of the fractal
    Set groupObj = docObj.GroupItems.Add
    ReDim NewPointList(5 * (Points + 1) + 1, 2)
    NewPoints = 0
    ' replace each straight line segment with the 5 segments
    ' of the replicator
    For i = 0 To Points - 1
        StartX = PointList(i, 0)
        StartY = PointList(i, 1)
        EndX = PointList(i + 1, 0)
        EndY = PointList(i + 1, 1)
        DeltaX = EndX - StartX
        Deltay = EndY - StartY
        NewPointList(NewPoints, 0) = StartX
        NewPointList(NewPoints, 1) = StartY
        NewPoints = NewPoints + 1
        If (0 = Deltay) Then
            Delta = DeltaX / 3
            NewPointList(NewPoints, 0) = StartX + Delta
            NewPointList(NewPoints, 1) = StartY
            NewPoints = NewPoints + 1
            NewPointList(NewPoints, 0) = StartX + Delta
            NewPointList(NewPoints, 1) = StartY + Delta
            NewPoints = NewPoints + 1
            NewPointList(NewPoints, 0) = StartX + (2 * Delta)
            NewPointList(NewPoints, 1) = StartY + Delta
            NewPoints = NewPoints + 1
            NewPointList(NewPoints, 0) = StartX + (2 * Delta)
            NewPointList(NewPoints, 1) = StartY
            NewPoints = NewPoints + 1
        Else
            Delta = Deltay / 3
            NewPointList(NewPoints, 0) = StartX
            NewPointList(NewPoints, 1) = StartY + Delta
            NewPoints = NewPoints + 1
            NewPointList(NewPoints, 0) = StartX - Delta
            NewPointList(NewPoints, 1) = StartY + Delta
            NewPoints = NewPoints + 1
            NewPointList(NewPoints, 0) = StartX - Delta
            NewPointList(NewPoints, 1) = StartY + (2 * Delta)
            NewPoints = NewPoints + 1
            NewPointList(NewPoints, 0) = StartX
            NewPointList(NewPoints, 1) = StartY + (2 * Delta)
            NewPoints = NewPoints + 1
       End If
    Next i
    NewPointList(NewPoints, 0) = EndX
    NewPointList(NewPoints, 1) = EndY
    
    Points = NewPoints
    ReDim PointList(Points, 2)
    For i = 0 To Points
        PointList(i, 0) = NewPointList(i, 0)
        PointList(i, 1) = NewPointList(i, 1)
    Next i
    For i = 0 To Points - 1
        CreateLine groupObj, PointList(i, 0), PointList(i, 1), PointList(i + 1, 0), PointList(i + 1, 1), 100
    Next i
Next level

End Sub
Rem a utility routine for creating lines with an start and an end point
Private Sub CreateLine(inGroupItem As Illustrator.GroupItem, inStartX As Double, inStartY As Double, inEndX As Double, inEndY As Double, inOpacity As Double)
Dim pathItem As Illustrator.pathItem
Set pathItem = inGroupItem.PathItems.Add

pathItem.SetEntirePath Array(Array(inStartX, inStartY), Array(inEndX, inEndY))
pathItem.Opacity = inOpacity

End Sub