[VBA函数]：写了一个利用圆弧上的任意三点绘制圆弧函数

gzmkshjsh

我写的一个利用任意三点绘制圆弧的函数Add3pointArc：

Public Function GetPointAR(ByVal ptBase As Variant, ByVal angle As Double, ByVal length As Double) As Variant
    Dim pt(0 To 2) As Double
    pt(0) = ptBase(0) + length * Cos(angle)
    pt(1) = ptBase(1) + length * Sin(angle)
    pt(2) = ptBase(2)
    GetPointAR = pt
End Function
Public Function Add3pointArc(ByVal FirstPoint, ByVal NextPoint, ByVal ThreePoint) As AcadArc '此圆弧三点为逆时针方向输入
    Dim CPt As Variant
    Dim CenterPoint(0 To 2) As Double
    Dim Line1 As AcadLine
    Dim Line2 As AcadLine
    Dim TemPt1(0 To 2) As Double
    Dim TemPt2(0 To 2) As Double
    Dim Angle1, Angle2 As Double
    pi = 4 * Atn(1)
    α1 = ThisDrawing.Utility.AngleFromXAxis(FirstPoint, NextPoint)
    α2 = ThisDrawing.Utility.AngleFromXAxis(NextPoint, ThreePoint)
    β1 = α1 + pi / 2
    β2 = α2 + pi / 2
    Length1 = 10
    TemPt1(0) = (FirstPoint(0) + NextPoint(0)) / 2
    TemPt1(1) = (FirstPoint(1) + NextPoint(1)) / 2
    TemPt1(2) = 0
    TemPt2(0) = (NextPoint(0) + ThreePoint(0)) / 2
    TemPt2(1) = (NextPoint(1) + ThreePoint(1)) / 2
    TemPt2(2) = 0

    Set Line1 = AddLineR(TemPt1, β1, Length1)
    Set Line2 = AddLineR(TemPt2, β2, Length1)

    CPt = Line1.IntersectWith(Line2, acExtendBoth)
    Line1.Delete
    Line2.Delete
    CenterPoint(0) = CPt(0)
    CenterPoint(1) = CPt(1)
    CenterPoint(2) = CPt(2)
    Angle1 = ThisDrawing.Utility.AngleFromXAxis(CenterPoint, FirstPoint)
    Angle2 = ThisDrawing.Utility.AngleFromXAxis(CenterPoint, ThreePoint)

    r1 = Sqr((FirstPoint(0) - CenterPoint(0)) ^ 2 + (FirstPoint(1) - CenterPoint(1)) ^ 2)
    Set Add3pointArc = ThisDrawing.ModelSpace.AddArc(CenterPoint, r1, Angle1, Angle2)

End Function

Sub test3PArc()

Add3pointArc ThisDrawing.Utility.GetPoint, ThisDrawing.Utility.GetPoint, ThisDrawing.Utility.GetPoint

End Sub
请斑竹看看有没有不妥的地方。有没有更简单的方法？

雪山飞狐(lzh)

这里有一个任意三点画弧的函数，你可以看看
http://www.mjtd.com/bbs/dispbbs. ... p;skin=0&page=1

gzmkshjsh

在明经通道上看了斑竹的贴子，不过我上面的函数少贴了一段如下：
Public Function AddLineR(ByVal ptSt As Variant, ByVal angle As Double, ByVal length As Double) As AcadLine
    Dim ptEn  As Variant
    ptEn = GetPointAR(ptSt, angle, length)
    Set AddLineR = ThisDrawing.ModelSpace.AddLine(ptSt, ptEn)
End Function
加上上面的代码，我在机子上试了，只要是逆时针方向选择任意三点，所绘制圆弧均通过这三点。
斑竹的程序确定精练，回去好好研究一下。

gzmkshjsh

斑竹你好，你所写的利用任意三点绘制圆弧的函数我下载后试了，在运行过程中出现了编译错误：子过程或函数未定义（在程序中显示为GetDistance函数有问题）。请问斑竹是怎么回事？
同时还有个问题想请教斑竹：在任意三点绘制圆弧函数中利用了GetCenOf3Pt函数（利用三点计算出圆心和半径）。GetCenOf3Pt函数的设计思路是不是根据先设定圆心坐标，再通过圆心到第一点的距离等于圆心到第二点的距离和圆心到第一点的距离等于圆心到第三点的距离两个第式求圆心坐标的？？

雪山飞狐(lzh)

function GetDistance(p1 , p2) as double
GetDistance=((p1(0)-p2(0))^2+(p1(1)-p2(1))^2 )^0.5
end function

gzmkshjsh

谢谢斑竹，我在VBA帮助文件中找到了GetDistance，为什么不能直接求出已知两点距离。
还要请斑竹解答GetCenOf3Pt函数的设计思路，由于水平有限，你所写的程序我无法找到其原理，向斑竹学习？？！！！！

雪山飞狐(lzh)

GetCenOf3Pt可不是我写的：）
它的实现实际上和手绘的原理一样

gzmkshjsh

谁写的不重要，重要的是能实现一定的功能。
我认为GetCenOf3Pt函数与手绘的原理不一样，我上面所写的函数的原理与手绘的原理一样，且是你在以前贴子上所写的思路。