[VBA函数]：已知两点坐标和半径，编程怎么画圆弧？

xiaokai

cad的画圆弧的命令可以是过已知两点（也既这两点为圆弧的端点），和已知圆弧的半径，就可以画出该圆弧，那么vba怎么实现这个方法来画圆弧？
谢谢！

雪山飞狐(lzh)

分别过两点以半径做圆，求两圆的交点即圆心，会有两个圆心

ahlzl

我写了函数：[php]
Public Function Arc_StPtEnPtR(StartPoint As Variant, EndPoint As Variant, R As Double, Bool As Boolean) As AcadArc
    '起点、终点、半径画圆弧
    'Bool为True，逆时针画弧；Bool为False，顺时针画弧
    Dim X As Double, D As Double, Ang As Double
    Const PI = 3.1415926535897
    D = dis(StartPoint, EndPoint)
   
    If R < 0.5 * D Then
        MsgBox ("圆弧不存在！")
        End
    End If
   
    Dim CenAng As Double, StartAng As Double, EndAng As Double, CenPoint  As Variant
    Ang = ThisDrawing.Utility.AngleFromXAxis(StartPoint, EndPoint)
    X = 2 * Atn(0.5 * D / Sqr(R * R - 0.25 * D * D))
    CenAng = Ang - X * 0.5 + PI / 2
    CenPoint = ThisDrawing.Utility.PolarPoint(StartPoint, CenAng, R)
    StartAng = CenAng + PI
    EndAng = StartAng + X
   
    Dim ArcObj1 As AcadArc, ArcObj2 As AcadArc
    Set ArcObj1 = ThisDrawing.ModelSpace.AddArc(CenPoint, R, StartAng, EndAng)
    Set Arc_StPtEnPtLength = ArcObj1
   
    If Bool = False Then
        Set ArcObj2 = ArcObj1.Mirror(StartPoint, EndPoint)
        ArcObj1.Delete
        Set Arc_StPtEnPtR = ArcObj2
    End If
End Function

Public Function dis(Pa, Pb As Variant) As Double
    '两点的距离
    dis = ((Pa(0) - Pb(0)) ^ 2 + (Pa(1) - Pb(1)) ^ 2 + (Pa(2) - Pb(2)) ^ 2) ^ 0.5
End Function[/php]

ahlzl

用这程序调用：[php]
Sub test()
   Dim Obj As AcadArc
   Dim p1, p2 As Variant, R As Double
   p1 = ThisDrawing.Utility.GetPoint(, vbarlf & " 请输入圆弧起点：")
   p2 = ThisDrawing.Utility.GetPoint(p1, vbarlf & " 请输入圆弧终点：")
   R = ThisDrawing.Utility.GetDistance(p1, vbCrLf & " 请输入圆弧半径：")
   Set Obj = Arc_StPtEnPtR(p1, p2, 100, True)
End Sub[/php]