vb三点求圆，多点求外接圆

 
 

  
  '本程序运行时耗时约为5-7秒。
 
 
 
 

  
  '以前在vb版回复问题时编写。
 
 
 
 

  
  


 
 
 
 

  
  
 
   

     VBScript code 
   
 
   
 
    
Option Explicit 
  
 Private Type mypoint 
   x As Double 
   y As Double 
 End Type 
  
 Dim p(0 To 49) As mypoint 
 Dim smallcx As Double 
 Dim smallcy As Double 
 Dim smallr As Double 
  
 Private Sub Form_Load() 
   '开始时将smallr都置成很大 
   smallr = 1E+90 
 End Sub 
  
 Private Function equ(ByVal a As Double,ByVal b As Double) As Boolean 
   If Abs(a - b)  < 0.000001 Then 
     equ = True 
   Else 
     equ = False 
   End If 
 End Function 
  
 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 
   Dim a As Double,b As Double,e As Double 
    
   a = (x1 + x2) * (x1 - x2) + (y1 + y2) * (y1 - y2) 
   b = (x3 + x2) * (x3 - x2) + (y3 + y2) * (y3 - y2) 
   e = (x1 - x2) * (y3 - y2) - (x2 - x3) * (y2 - y1) 
  
   Is_Three_Point_In_A_Line = equ(e,0) 
  
 End Function 
  
 Private Sub Calc_TPC(ByVal x1 As Double,ByVal y3 As Double,cx As Double,cy As Double,r As Double) 
   Dim a As Double,e As Double 
  
   a = (x1 + x2) * (x1 - x2) + (y1 + y2) * (y1 - y2) 
   b = (x3 + x2) * (x3 - x2) + (y3 + y2) * (y3 - y2) 
   e = (x1 - x2) * (y3 - y2) - (x2 - x3) * (y2 - y1) 
  
   cx = (a * (y3 - y2) + b * (y2 - y1)) / (2 * e) 
   cy = (a * (x2 - x3) + b * (x1 - x2)) / (2 * e) 
   r = Sqr((x1 - cx) * (x1 - cx) + (y1 - cy) * (y1 - cy)) 
    
    
 End Sub 
  
 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 
   Dim l1 As Double,l2 As Double 
    
   l1 = px - cx 
   l2 = py - cy 
    
   If Sqr(l1 * l1 + l2 * l2)  <= r Then 
     incircle = True 
   Else 
     incircle = False 
   End If 
    
 End Function 
 Private Sub Command1_Click() 
   Cls 
    
   Randomize Timer 
    
   Dim i As Long,j As Long,k As Long 
   Dim l As Long 
   Dim cx As Double,r As Double 
   Dim count As Long 
    
   '先生成50个点，并显示在屏幕上 
   For i = 0 To 49 
     p(i).x = Rnd * 2000 
     p(i).y = Rnd * 2000 
     Me.Circle (p(i).x,p(i).y),15,vbRed 
   Next i 
    
   '计算所有的圆 
   For i = 0 To 49 
     For j = 0 To 49 
       For k = 0 To 49 
         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 
           '三点可求圆 
            
           '求圆 
           Calc_TPC p(i).x,p(k).y,cx,cy,r 
            
           '计算所有的点是否在圆内 
           count = 0 
           For l = 0 To 49 
             If incircle(cx,r,p(l).x,p(l).y) Then 
               count = count + 1 
             End If 
           Next l 
            
           If count = 50 Then 
             '所有的点都在圆内 
             If r  < smallr Then 
               smallcx = cx 
               smallcy = cy 
               smallr = r 
             End If 
           End If 
         End If 
       Next k 
     Next j 
   Next i 
    
   '画出最小的圆 
   Circle (smallcx,smallcy),smallr,vbGreen 
 End Sub
 
    
 
    
 
    
 
    
 
     
版权声明：本文为博主原创文章，未经博主允许不得转载。
 
    
 
   
 
  
 
 





 
 





 
 


  
  

  
  

  
  

  
  

  
  

  
  

 
 


 
 

   
 
 

    

 
 

 
 

            
  
  
上一篇taoism 2 解析stk
            
  
  
下一篇两直线求交点