Option Explicit
Const pi As Double = 3.14159265358979
Public Sub z6(r1 As Double, r2 As Double, r3 As Double, h As Double, n As Integer)
    Dim pline1 As AcadLWPolyline, pline2 As AcadLWPolyline
    Dim solid1 As Acad3DSolid, solid2 As Acad3DSolid
    Set pline1 = plineToExtrude(r2, r3, n)
    Set pline2 = plineToRevolve(r1, r2, r3, h)
    Set solid1 = Extrude0(pline1, h)
    Set solid2 = Revolve0(pline2, Array(0, 1, 0), -pi / 2, Array(0, 0, 1), 2 * pi)
    Call solid1.Boolean(acIntersection, solid2)
    solid1.Update

End Sub
Private Function plineToExtrude(r2 As Double, r3 As Double, n As Integer) As AcadLWPolyline
    Dim i As Integer, outer_angle As Double, inner_angle As Double, vertices() As Double
    ReDim vertices(6 * n - 1)
    For i = 0 To 2 * n - 1
       outer_angle = pi / n * (i - 0.5)
        inner_angle = pi / n * (i - 1)
        If i Mod 2 = 0 Then vertices(3 * i) = r2 * Cos(inner_angle):  vertices(3 * i + 1) = r2 * Sin(inner_angle): vertices(3 * i + 2) = r3 * Cos(outer_angle): vertices(3 * i + 3) = r3 * Sin(outer_angle)
        If i Mod 2 <> 0 Then vertices(3 * i + 1) = r3 * Cos(outer_angle): vertices(3 * i + 2) = r3 * Sin(outer_angle)
    Next
    Set plineToExtrude = ThisDrawing.ModelSpace.AddLightWeightPolyline(vertices)
    plineToExtrude.Closed = True
    Dim bulge As Double
    bulge = CalcBulge(plineToExtrude.Coordinate(0), plineToExtrude.Coordinate(1), r3)
    For i = 0 To 3 * n - 1
        If i Mod 3 = 1 Then Call plineToExtrude.SetBulge(i, bulge)
    Next
    plineToExtrude.Update
End Function

Private Function plineToRevolve(r1 As Double, r2 As Double, r3 As Double, h As Double) As AcadLWPolyline
    Dim vertices() As Double
    vertices = VerticesFromParamArray(0, r1, h, r1, h, r2 - h / 3, 2 * h / 3, r2, 2 * h / 3, r3 - h / 3, h, r3, 2 * h / 3, r3, h / 3, r3 - h / 3, h / 3, r2, 0, r2 - h / 3)
    Set plineToRevolve = ThisDrawing.ModelSpace.AddLightWeightPolyline(vertices)
    plineToRevolve.Closed = True

    Dim bulge As Double, d As Double
    d = Sqr((2 * h / 3) * (2 * h / 3)) / 2
    bulge = (2 * h / 3 - Sqr((2 * h / 3) * (2 * h / 3) - d * d)) / d

    Dim i As Integer
    For i = 0 To 8
    If i Mod 2 = 0 And i Mod 2 <> 0 Then Call plineToRevolve.SetBulge(i, -bulge)
    Next
    plineToRevolve.Update

End Function
Private Function CalcBulge(p1 As Variant, p2 As Variant, r As Double) As Double
    Dim d As Double
    d = Sqr((p2(0) - p1(0)) * (p2(0) - p1(0)) + (p2(1) - p1(1)) * (p2(1) - p1(1))) / 2
    CalcBulge = (r - Sqr(r * r - d * d)) / d
End Function
Private Function VerticesFromParamArray(ParamArray input() As Variant) As Double()
    ReDim output(UBound(ulaz)) As Double: Dim i As Integer
    For i = 0 To UBound(ulaz)
        output(i) = input(i)
    Next
    VerticesFromParamArray = output
End Function
Private Function Extrude0(ent As AcadEntity, h As Double) As Acad3DSolid
    Dim rgn As AcadRegion
    Set rgn = RegionFromEntity(ent)
    Set Extrude0 = ThisDrawing.ModelSpace.AddExtrudedSolid(rgn, h, 0)
    Extrude0.Update
    rgn.Delete: ent.Delete
End Function
Private Function Revolve0(ent As AcadEntity, v1 As Variant, a1 As Double, v2 As Variant, _
                          a2 As Double) As Acad3DSolid
    Dim p1(2) As Double, p2(2) As Double, rgn As AcadRegion
    Set rgn = RegionFromEntity(ent)
    p2(0) = v1(0): p2(1) = v1(1): p2(2) = v1(2)
    Call rgn.Rotate3D(p1, p2, a1)
    p2(0) = v2(0): p2(1) = v2(1): p2(2) = v2(2)
    Set Revolve0 = ThisDrawing.ModelSpace.AddRevolvedSolid(rgn, p1, p2, a2)
    Revolve0.Update
    rgn.Delete: ent.Delete
End Function
Private Function RegionFromEntity(ent As AcadEntity) As AcadRegion
    Dim ents(0) As AcadEntity: Set ents(0) = ent
    Set RegionFromEntity = ThisDrawing.ModelSpace.AddRegion(ents)(0)
End Function