|
▼きりんさん さん:
こんばんは。
以前、円を描いたコードをちょっと変更しました。
Functionにした方が便利そうだったので再送です。
>はじめまして、
>ワ−クシ−トに絶対座標を使って、正確に円弧を描くVBAマクロを教えて下さい。
> 与条件
> 1.円弧の中心座標 Xo、Yo
> 2.円弧の半径 Ro
> 3.円弧の開始角度 Ii
> 3.円弧の終点角度 Io
> 角度は、左廻りです。
>宜しくお願いします。
>
'==============================================================
Sub main()
Dim shp As Shape
Set shp = Mk_enko(ActiveSheet, 300, 100, 60, 45, 270)
End Sub
'=========================================================================
Function Mk_enko(sht As Worksheet, x As Double, y As Double, rs As Double, std As Double, edd As Double) As Shape
'円弧を作成する
'sht-----作成するシート
'x,y-----中心座標
'rs------半径
'std----開始角度
'edd----終了角度
'出力---Mk_enko--Shapeオブジェクト
pai = WorksheetFunction.Pi
strd = (1.5 - std / 180) * pai
edrs = (1.5 - edd / 180) * pai
With sht.Shapes.BuildFreeform(msoEditingAuto, x + rs * Cos(strd), y + rs * Sin(strd))
For idx = strd - 0.15 To edrs Step -0.001
.AddNodes msoSegmentLine, msoEditingAuto, x + rs * Cos(idx), y + rs * Sin(idx)
Next idx
Set Mk_enko = .ConvertToShape
Mk_enko.Fill.Visible = msoFalse
End With
End Function
|
|