View Single Post
Old 09-09-2009, 16:36
Posts: n/a
Default Didn't work but have bulky solution

Originally Posted by Alex View Post
Thanks Alex. I tried it but it doesn't work (I may be missing something though). It is still reporting the area as the outer shape area + inner shape area. Here's the one line code:

donutArea = ActiveSelection.Shapes.First.Curve.Contour(0).Area
I did write some bulky code to accomplish it though by breaking the shape apart, getting the areas for each of the shapes, finding the largest and subtracting the smaller ones from it. This of course won't work though if there is an island that is part of the outer shape but located inside the donut hole as it would subtract it from the outershape instead of adding it... (which is in fact the case as I just tested it).

Public Function donutArea() As Double
    Dim donutShape As Shape, donut As ShapeRange
    Dim donutAreas() As Double, donutMax As Double
    Dim countShapes As Integer, i As Integer
    'copy the donut shape and break it apart into individual shapes
    Set donut = ActiveSelection.Duplicate(0, 0).BreakApartEx
    'get number of shapes and redimension the array
    countShapes = donut.Shapes.Count
    ReDim donutAreas(countShapes + 2)
    'get area of all shapes
    For i = 1 To countShapes
        donutAreas(i) = donut.Shapes(i).Curve.Area
    Next i
    'find largest shape and subtract smaller shapes from it
    donutAreas(countShapes + 1) = 0
    For i = 2 To countShapes + 1
        If donutAreas(i) > donutAreas(i - 1) Then donutMax = 2 * donutAreas(i)
        donutArea = donutArea + donutAreas(i - 1)
    Next i
    donutArea = donutMax - donutArea
    'clean up
End Function
Reply With Quote