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