AutoVBA会制图元填充指定图案

贴一段代码先。

Sub drawcircularpavers()
    Dim brickcircles() As AcadCircle
    Dim counter As Integer, radius As Double
    Dim center As Integer
    ReDim brickcircles(txtnumberofcircles)
    With ThisDrawing.Utility
        radius = .GetDistance(center, "Enter the radius.")
    End With
    For counter = 0 To txtnumberofcircles - 1
        Set brickcircles(counter) = ThisDrawing.ModelSpace.AddCircle(center, radius - counter * radius / txtnumberofcircles)
        brickcircles(counter).color = acRed
        brickcircles(counter).Update
        drawmortar center, counter, radius
    Next
End Sub
Sub drawmortar(center As Variant, counter As Integer, radius As Double)
     Dim startpoint(0 To 2) As Double, endpoint(0 To 2) As Double
     Dim theta As Double, stepsize As Double
     Static adjust As Double
     If frmcircleofbircks.optbrickparallel = True Then
        stepsize = 15 * pi / 180
    Else
        stepsize = 30 * pi / 180
        If adjust = 0# Then
            adjust = 15 * pi / 180
        Else
            adjust = 0#
        End If
    End If
    For theta = 0 To 360 * pi / 180 Step stepzise
        startpoint(0) = (radius - counter * radius / txtnumberofcricles) * Cos(theta + adjust) + center(0)
        startpoint(1) = (radius - counter * radius / txtnumberofcircles) * Sin(theta + adjust) + center(1)
        endpoint(0) = (radius - (counter + 1) * radius / txtnumberofcircles) * Cos(theta_adjust) + center(0)
        endpoint(1) = (radius - (counter + 1) * radius / txtnumberofcircles) * Sin(theta + adjust) + center(1)
        startpoint(2) = 0#: endpoint(2) = 0#
        With ThisDrawing.ModelSpace
            .AddLine startpoint, endpoint
            .Item(ModelSpace.Count - 1).Update
        End With
    Next
End Sub

绘制圆再填充砖型图案。