vb三点求圆,多点求外接圆。

前端之家收集整理的这篇文章主要介绍了vb三点求圆,多点求外接圆。前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。
  1. '本程序运行时耗时约为5-7秒。
  2. '以前在vb回复问题时编写。
  3. VBScript code
  4. Option Explicit 
  5.   
  6.  Private Type mypoint 
  7.    x As Double 
  8.    y As Double 
  9.  End Type 
  10.   
  11.  Dim p(0 To 49) As mypoint 
  12.  Dim smallcx As Double 
  13.  Dim smallcy As Double 
  14.  Dim smallr As Double 
  15.   
  16.  Private Sub Form_Load() 
  17.    '开始时将smallr都置成很大 
  18.    smallr = 1E+90 
  19.  End Sub 
  20.   
  21.  Private Function equ(ByVal a As Double,ByVal b As Double) As Boolean 
  22.    If Abs(a - b)  < 0.000001 Then 
  23.      equ = True 
  24.    Else 
  25.      equ = False 
  26.    End If 
  27.  End Function 
  28.   
  29.  Private Function Is_Three_Point_In_A_Line(ByVal x1 As Double,ByVal y1 As Double,ByVal x2 As Double,ByVal y2 As Double,ByVal x3 As Double,ByVal y3 As Double) As Boolean 
  30.    Dim a As Double,b As Double,e As Double 
  31.     
  32.    a = (x1 + x2) * (x1 - x2) + (y1 + y2) * (y1 - y2) 
  33.    b = (x3 + x2) * (x3 - x2) + (y3 + y2) * (y3 - y2) 
  34.    e = (x1 - x2) * (y3 - y2) - (x2 - x3) * (y2 - y1) 
  35.   
  36.    Is_Three_Point_In_A_Line = equ(e,0) 
  37.   
  38.  End Function 
  39.   
  40.  Private Sub Calc_TPC(ByVal x1 As Double,ByVal y3 As Double,cx As Double,cy As Double,r As Double) 
  41.    Dim a As Double,e As Double 
  42.   
  43.    a = (x1 + x2) * (x1 - x2) + (y1 + y2) * (y1 - y2) 
  44.    b = (x3 + x2) * (x3 - x2) + (y3 + y2) * (y3 - y2) 
  45.    e = (x1 - x2) * (y3 - y2) - (x2 - x3) * (y2 - y1) 
  46.   
  47.    cx = (a * (y3 - y2) + b * (y2 - y1)) / (2 * e) 
  48.    cy = (a * (x2 - x3) + b * (x1 - x2)) / (2 * e) 
  49.    r = Sqr((x1 - cx) * (x1 - cx) + (y1 - cy) * (y1 - cy)) 
  50.     
  51.     
  52.  End Sub 
  53.   
  54.  Private Function incircle(ByVal cx As Double,ByVal cy As Double,ByVal r As Double,ByVal px As Double,ByVal py As Double) As Boolean 
  55.    Dim l1 As Double,l2 As Double 
  56.     
  57.    l1 = px - cx 
  58.    l2 = py - cy 
  59.     
  60.    If Sqr(l1 * l1 + l2 * l2)  <= r Then 
  61.      incircle = True 
  62.    Else 
  63.      incircle = False 
  64.    End If 
  65.     
  66.  End Function 
  67.  Private Sub Command1_Click() 
  68.    Cls 
  69.     
  70.    Randomize Timer 
  71.     
  72.    Dim i As Long,j As Long,k As Long 
  73.    Dim l As Long 
  74.    Dim cx As Double,r As Double 
  75.    Dim count As Long 
  76.     
  77.    '生成50个点,并显示在屏幕上 
  78.    For i = 0 To 49 
  79.      p(i).x = Rnd * 2000 
  80.      p(i).y = Rnd * 2000 
  81.      Me.Circle (p(i).x,p(i).y),15,vbRed 
  82.    Next i 
  83.     
  84.    '计算所有的圆 
  85.    For i = 0 To 49 
  86.      For j = 0 To 49 
  87.        For k = 0 To 49 
  88.          If Not Is_Three_Point_In_A_Line(p(i).x,p(i).y,p(j).x,p(j).y,p(k).x,p(k).y) Then 
  89.            '三点可求圆 
  90.             
  91.            '求圆 
  92.            Calc_TPC p(i).x,p(k).y,cx,cy,r 
  93.             
  94.            '计算所有的点是否在圆内 
  95.            count = 0 
  96.            For l = 0 To 49 
  97.              If incircle(cx,r,p(l).x,p(l).y) Then 
  98.                count = count + 1 
  99.              End If 
  100.            Next l 
  101.             
  102.            If count = 50 Then 
  103.              '所有的点都在圆内 
  104.              If r  < smallr Then 
  105.                smallcx = cx 
  106.                smallcy = cy 
  107.                smallr = r 
  108.              End If 
  109.            End If 
  110.          End If 
  111.        Next k 
  112.      Next j 
  113.    Next i 
  114.     
  115.    '画出最小的圆 
  116.    Circle (smallcx,smallcy),smallr,vbGreen 
  117.  End Sub
  118.  
  119. 版权声明:本文为博主原创文章,未经博主允许不得转载。

  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
    •  
    •  
    •  
    •  
    •  
    •  
    •  
    •  

    猜你在找的VB相关文章