【自我挑战72】
<P>求a值：</P> 我把71题的代码，加了一点：Sub Joseflin_72()
Dim x0 As Double, x As Double, fx As Double, flx As Double
Dim A As Double, B As Double, C As Double, D As Double
Const pi = 3.1415926535897
x0 = 0.01
x1 = x0
Do
x0 = x1
A = (1 - 3 * x0 - 2 * x0 * x0) / (1 - 3 * x0 + 2 * x0 * x0)
B = (1 - 5 * x0 - 6 * x0 * x0) / (1 - 5 * x0 + 6 * x0 * x0)
C = x0 / (1 - x0)
D = 3 * x0 / (1 - 3 * x0)
fx = Atn(Sqr(1 - A * A) / A) + Atn(Sqr(1 - B * B) / B) + _
Atn(C / Sqr(1 - C * C)) + Atn(D / Sqr(1 - D * D)) - 1
flx = (-1 / Sqr(1 - A * A)) * (12 * x0 * x0 - 8 * x0) / (1 - 3 * x0 + 2 * x0 * x0) ^ 2 + _
(-1 / Sqr(1 - B * B)) * (60 * x0 * x0 - 24 * x0) / (1 - 5 * x0 + 6 * x0 * x0) ^ 2 + _
(1 / Sqr(1 - C * C)) / (1 - x0) ^ 2 + (1 / Sqr(1 - D * D)) * 3 / (1 - 3 * x0) ^ 2
x1 = x0 - fx / flx
Loop While Abs(x1 - x0) > 0.0000000000001
x1 = 100 * x1
Dim L1 As AcadLine, L2 As AcadLine, Arc As AcadArc
Dim P0(2) As Double, P1 As Variant, P2 As Variant
P0(0) = 0: P0(1) = 0: P0(2) = 0
P1 = ThisDrawing.Utility.PolarPoint(P0, 0.5 * pi - 0.5, 100)
P2 = ThisDrawing.Utility.PolarPoint(P0, 0.5 * pi + 0.5, 100)
Set L1 = ThisDrawing.ModelSpace.AddLine(P0, P1)
Set L2 = ThisDrawing.ModelSpace.AddLine(P0, P2)
Set Arc = ThisDrawing.ModelSpace.AddArc(P0, 100, 0.5 * pi - 0.5, 0.5 * pi + 0.5)
Dim cenPt1 As Variant, ang1 As Double, C1 As AcadCircle
ang1 = 0.5 * pi + 0.5 - Atn(C / Sqr(1 - C * C))
cenPt1 = ThisDrawing.Utility.PolarPoint(P0, ang1, 100 - x1)
Set C1 = ThisDrawing.ModelSpace.AddCircle(cenPt1, x1)
Dim cenPt2 As Variant, ang2 As Double, C2 As AcadCircle
ang2 = ang1 - Atn(Sqr(1 - A * A) / A)
cenPt2 = ThisDrawing.Utility.PolarPoint(P0, ang2, 100 - 2 * x1)
Set C2 = ThisDrawing.ModelSpace.AddCircle(cenPt2, 2 * x1)
Dim cenPt3 As Variant, ang3 As Double, C3 As AcadCircle
ang3 = 0.5 * pi - 0.5 + Atn(D / Sqr(1 - D * D))
cenPt3 = ThisDrawing.Utility.PolarPoint(P0, ang3, 100 - 3 * x1)
Set C3 = ThisDrawing.ModelSpace.AddCircle(cenPt3, 3 * x1)
ZoomExtents
MsgBox "小圆半径＝" & x1, , "Joseflin_自我挑战72"
End Sub
<P>楼上的强！</P>
<P>佩服！</P>
页:
[1]