【自我挑战72】

Joseflin

求a值：

ahlzl

我把71题的代码，加了一点：

2. Sub Joseflin_72()
3.     Dim x0 As Double, x As Double, fx As Double, flx As Double
4.     Dim A As Double, B As Double, C As Double, D As Double
5.     Const pi = 3.1415926535897
6.     x0 = 0.01
7.     x1 = x0
8.     Do
9.         x0 = x1
10.         A = (1 - 3 * x0 - 2 * x0 * x0) / (1 - 3 * x0 + 2 * x0 * x0)
11.         B = (1 - 5 * x0 - 6 * x0 * x0) / (1 - 5 * x0 + 6 * x0 * x0)
12.         C = x0 / (1 - x0)
13.         D = 3 * x0 / (1 - 3 * x0)
14.         fx = Atn(Sqr(1 - A * A) / A) + Atn(Sqr(1 - B * B) / B) + _
15.              Atn(C / Sqr(1 - C * C)) + Atn(D / Sqr(1 - D * D)) - 1
16.         flx = (-1 / Sqr(1 - A * A)) * (12 * x0 * x0 - 8 * x0) / (1 - 3 * x0 + 2 * x0 * x0) ^ 2 + _
17.               (-1 / Sqr(1 - B * B)) * (60 * x0 * x0 - 24 * x0) / (1 - 5 * x0 + 6 * x0 * x0) ^ 2 + _
18.               (1 / Sqr(1 - C * C)) / (1 - x0) ^ 2 + (1 / Sqr(1 - D * D)) * 3 / (1 - 3 * x0) ^ 2
19.         x1 = x0 - fx / flx
20.     Loop While Abs(x1 - x0) > 0.0000000000001
21.    
22.     x1 = 100 * x1
23.     Dim L1 As AcadLine, L2 As AcadLine, Arc As AcadArc
24.     Dim P0(2) As Double, P1 As Variant, P2 As Variant
25.     P0(0) = 0: P0(1) = 0: P0(2) = 0
26.     P1 = ThisDrawing.Utility.PolarPoint(P0, 0.5 * pi - 0.5, 100)
27.     P2 = ThisDrawing.Utility.PolarPoint(P0, 0.5 * pi + 0.5, 100)
28.     Set L1 = ThisDrawing.ModelSpace.AddLine(P0, P1)
29.     Set L2 = ThisDrawing.ModelSpace.AddLine(P0, P2)
30.     Set Arc = ThisDrawing.ModelSpace.AddArc(P0, 100, 0.5 * pi - 0.5, 0.5 * pi + 0.5)
31.    
32.     Dim cenPt1 As Variant, ang1 As Double, C1 As AcadCircle
33.     ang1 = 0.5 * pi + 0.5 - Atn(C / Sqr(1 - C * C))
34.     cenPt1 = ThisDrawing.Utility.PolarPoint(P0, ang1, 100 - x1)
35.     Set C1 = ThisDrawing.ModelSpace.AddCircle(cenPt1, x1)
36.    
37.     Dim cenPt2 As Variant, ang2 As Double, C2 As AcadCircle
38.     ang2 = ang1 - Atn(Sqr(1 - A * A) / A)
39.     cenPt2 = ThisDrawing.Utility.PolarPoint(P0, ang2, 100 - 2 * x1)
40.     Set C2 = ThisDrawing.ModelSpace.AddCircle(cenPt2, 2 * x1)
41.    
42.     Dim cenPt3 As Variant, ang3 As Double, C3 As AcadCircle
43.     ang3 = 0.5 * pi - 0.5 + Atn(D / Sqr(1 - D * D))
44.     cenPt3 = ThisDrawing.Utility.PolarPoint(P0, ang3, 100 - 3 * x1)
45.     Set C3 = ThisDrawing.ModelSpace.AddCircle(cenPt3, 3 * x1)
46.     ZoomExtents
47.     MsgBox "小圆半径＝" & x1, , "Joseflin_自我挑战72"
48. End Sub

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

jiayu1983

楼上的强！

佩服！