|
??? |
|
Option Explicit
Sub Macro1() Dim Ax As Double, Ay As Double Dim Bx As Double, By As Double Dim Cx As Double, Cy As Double Dim Dx As Double, Dy As Double 'BCを11:7に内分する点D Dim Ex As Double, Ey As Doulbe 'BCを11:7に外分する点E Dim Fx As Double, Fy As Double, Fr As Double 'DEを直径とする円 Dim Mx As Double, My As Double Dim Nx As Double, Ny As Double Dim Px As Double, Py As Double Dim Qx As Double, Qy As Double, Qt As Double, Dim Rx As Double, Ry As Double Dim Sx As Double, Sy As Double Dim Ax_min As Double, Ax_max As Double, Axx As Double Dim kizami As Double, sa As Double Dim AB As Double, AC As Double, CQ As Double, SR As Double Dim a As Double, b As Double, c As Double, d As Double Dim dankai As Integer Cells(1, 1).Value = 10000 Mx = 0: My = 0 Bx = -1: By = 0 Cx = 1: Cy = 0 Dx = (7 * Bx + 11 * Cx) / (11 + 7): Dy = 0 Ex = (-7 * Bx + 11 * Cx) / (11 - 7): Ey = 0 Fx = (Dx + Ex) / 2: Fy = 0: Fr = Abs(Fx - Dx) Randomize Timer: Qt = Rnd(1) 'Qの位置はどこでもよさそうなので For dankai = 1 To 12 If dankai = 1 Then kizami = 0.01: Ax_min = Dx + kizami: Ax_max = Cx - kizami Else Ax_min = Axx - kizami: Ax_max = Axx + kizami: kizami = kizami * 0.1 End If For Ax = Ax_min To Ax_max Step kizami Ay = Fy + Sqr(Fr * Fr - (Ax - Fx) * (Ax - Fx)) Qx = ((1 - Qt) * Cx + Qt * Ax) / (Qt + (1 - Qt)) 'CAをQt:(1-Qt)に内分する点 Qy = ((1 - Qt) * Cy + Qt * Ay) / (Qt + (1 - Qt)) CQ = Sqr((Qx - Cx) * (Qx - Cx) + (Qy - Cy) * (Qy - Cy)) AB = Sqr((Bx - Ax) * (Bx - Ax) + (By - Ay) * (By - Ay)) Px = ((AB - CQ) * Bx + CQ * Ax) / (CQ + (AB - CQ)) 'BAをBP:(AB-BP)=CQ:(AB-CQ)に内分する点 Py = ((AB - CQ) * By + CQ * Ay) / (CQ + (AB - CQ)) Nx = (Px + Qx) / 2: Ny = (Py + Qy) / 2 'AC:y=(Cy-Ay)/(Cx-Ax)*(x-Ax)+Ay=a*x+b a = (Cy - Ay) / (Cx - Ax): b = a * (-Ax) + Ay 'SNM:y=(Ny-My)/(Nx-Mx)*(x-Mx)+My=c*x+d c = (Ny - My) / (Nx - Mx): d = c * (-Mx) + My 'Sy=a*Sx+b=c*Sx+d Sx = (d - b) / (a - c): Sy = a * Sx + b 'AB:y=(By-Ay)/(Bx-Ax)*(x-Ax)+Ay=a*x+b a = (By - Ay) / (Bx - Ax): b = a * (-Ax) + Ay 'Ry=a*Rx+b=c*Rx+d Rx = (d - b) / (a - c): Ry = a * Rx + b AC = Sqr((Cx - Ax) * (Cx - Ax) + (Cy - Ay) * (Cy - Ay)) SR = Sqr((Sx - Rx) * (Sx - Rx) + (Sy - Ry) * (Sy - Ry)) sa = Abs(SR / AC - 3 / 7) If Cells(1, 1).Value > sa Then Cells(1, 1).Value = sa Cells(1, 2).Value = Sqr((Rx - Mx) * (Rx - Mx) + (Ry - My) * (Ry - My)) * 7 / AC Axx = Ax End If Next Ax Next dankai End Sub |
|
4月12日（木） 12:41:32
39217 |