Thread: Error in CURVE.AREA property View Single Post
#4
09-09-2009, 16:36
 thayne Guest Posts: n/a
Didn't work but have bulky solution

Quote:
 Originally Posted by Alex ?Curve.Contour(0).Area
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:

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).

Code:
```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
donut.Delete

End Function```