用VBA编程，画一条曲线，如用三个点，怎么画？

zfbj

三点法（起点、第二点和终点）创建圆弧，首先计算出圆弧的圆心和半径，然后根据圆心、起点和终点，创建圆弧对象，其实现代码为：

Public Function AddArc3Pt(ByVal ptSt As Variant, ByVal ptSc As Variant, ByVal ptEn As Variant) As AcadArc

Dim objArc As AcadArc

Dim ptCen As Variant

Dim radius As Double

ptCen = GetCenOf3Pt(ptSt, ptSc, ptEn, radius)

Set objArc = AddArcCSEP(ptCen, ptSt, ptEn)

objArc.color = acGreen

objArc.Update

Set AddArc3Pt = objArc

End Function

GetCenOf3Pt是自定义的函数，能够根据三点计算出圆心和半径，其实现代码为：

Public Function GetCenOf3Pt(pt1 As Variant, pt2 As Variant, pt3 As Variant, _

ByRef radius As Double) As Variant

Dim xysm, xyse, xy As Double

Dim ptCen(2) As Double

xy = pt1(0) ^ 2 + pt1(1) ^ 2

xyse = xy - pt3(0) ^ 2 - pt3(1) ^ 2

xysm = xy - pt2(0) ^ 2 - pt2(1) ^ 2

xy = (pt1(0) - pt2(0)) * (pt1(1) - pt3(1)) - (pt1(0) - pt3(0)) * (pt1(1) - pt2(1))

'判断参数有效性

If Abs(xy) < 0.000001 Then

MsgBox "所输入的参数无法创建圆形！"

Exit Function

End If

'获得圆心和半径

ptCen(0) = (xysm * (pt1(1) - pt3(1)) - xyse * (pt1(1) - pt2(1))) / (2 * xy)

ptCen(1) = (xyse * (pt1(0) - pt2(0)) - xysm * (pt1(0) - pt3(0))) / (2 * xy)

ptCen(2) = 0

radius = Sqr((pt1(0) - ptCen(0)) * (pt1(0) - ptCen(0)) + (pt1(1) - ptCen(1)) * (pt1(1) - ptCen(1)))

If radius < 0.000001 Then

MsgBox "半径过小！"

Exit Function

End If

'函数返回圆心的位置，而半径则在参数中通过引用方式返回

GetCenOf3Pt = ptCen

End Function

需要注意的是，radius参数是按地址传递的，因此也是函数的返回值。

摘自《AutoCAD VBA精彩实例教程》第2章相关内容。

nxy_918

这里有现成的 http://www.vba.cn/function/list.asp?id=339&ordertype=byletter