View Single Post
  #4   Report Post  
Andy Pope
 
Posts: n/a
Default

Hi,

Here is a function that will draw a freeform arc.
The separate x and y radius allow you to draw ovals.

'-------------------------------
Sub FourQuadarents()
Dim shpArc As Shape

Set shpArc = CreateArc(100, 100, 0, 90)
Set shpArc = CreateArc(100, 100, 90, 180)
Set shpArc = CreateArc(100, 100, 180, 270)
' colour segement
CreateArc(100, 50, 270, 360).Fill.ForeColor.SchemeColor = 43

End Sub

Function CreateArc(XRadius As Single, YRadius As Single, _
StartAngle As Single, EndAngle As Single) As Shape
'
Dim intAngle As Integer
Dim dblA1 As Double
Dim dblB1 As Double
Dim dblA2 As Double
Dim dblB2 As Double
Const PI = 3.14159265358979

With ActiveSheet.Shapes.BuildFreeform( _
msoEditingAuto, XRadius, YRadius)
For intAngle = StartAngle To EndAngle
dblA2 = XRadius + (Cos((intAngle * (PI / 180))) * XRadius)
dblB2 = YRadius - (Sin((intAngle * (PI / 180))) * YRadius)
.AddNodes msoSegmentLine, msoEditingAuto, dblA2, dblB2
Next
.AddNodes msoSegmentLine, msoEditingAuto, XRadius, YRadius
Set CreateArc = .ConvertToShape
End With

End Function

Cheers
Andy

Johannes wrote:
Is there a way to draw an arc which is 1/4 of a circle?
It looks like Shapes.addcurve only draw bezier curve, but how do I make the
curve a 1/4 of a circle?

I also tried Shapes.BuildFreeForm().AddNodes(), but I couldn't get it to
draw 1/4 of a circle.



--

Andy Pope, Microsoft MVP - Excel
http://www.andypope.info