输入两点和弧长，画弧，谁能帮我，谢谢。

zdx411

输入两点和弧长，画弧，谁能帮我，弧的方向列所谓，画两个也可以。VBA，lisp,都可以。谢谢。

ahlzl

我以前写的。还有LISP，请到LISP版：dispbbs.asp?boardid=3&id=42791

Sub ddARC()
Dim ddARC As AcadArc
Dim S, L, R, a0, a1, fx, flx, c, angs, ange As Double
Dim pa, pb, cen As Variant
Const PI = 3.1415926535

pa = ThisDrawing.Utility.GetPoint(, "请输入圆弧起点：")
pb = ThisDrawing.Utility.GetPoint(pa, "请输入圆弧终点：")
S = ThisDrawing.Utility.GetDistance(pa, "请输入圆弧弧长：")

L = dis(pa, pb)
b = ThisDrawing.Utility.AngleFromXAxis(pa, pb)

If S <= L Then
MsgBox "您要画的圆弧并不存在，请再执行一次程序！"
End
End If

a0 = 2
a1 = a0
Do
a0 = a1
fx = Sin(a0 / 2) / a0 - L / (2 * S)
flx = (Cos(a0 / 2) * a0 * 0.5 - Sin(a0 / 2)) / (a0 * a0)
a1 = a0 - fx / flx
Loop While Abs(a1 - a0) > 0.0000000001

R = S / a1
c = b - a1 * 0.5 + 90 * PI / 180
cen = ThisDrawing.Utility.PolarPoint(pa, c, R)
angs = c + PI
ange = angs + a1

Set ddARC = ThisDrawing.ModelSpace.AddArc(cen, R, angs, ange)
End Sub

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

ahlzl

发完贴子，就不来了，这样的人以后谁愿意帮你！

galayan

正需要这样的程序呢

感谢！

3xxx

很受用啊。谢谢。

睡醒的蜗牛

支持xxxxxx

清风明月名字

谢谢楼主的分享！很有意思的代码，收藏备用。