VB获取二值图重心求点评

[dianyancao]

今天下午为了获取骨架图形不变矩，想到先获取图形重心。然后居然根据初中学的杠杆原理构造了一条无重量的水平刚体线迭代计算骨架重心。最后好像成功了。不知道有没有错误，希望大家指点。

另存为Module1.bas文件

Attribute VB_Name = "Module1"
Option Explicit

Type WeightPoint                         '受力点的重心位置和重量
  X As Double
  Y As Double
  Weight As Long
End Type

Type LineDataStruct
  O As WeightPoint                       '返回值 'A和B 的重心位置O和重量
  
  AX1Y1 As WeightPoint                   'A点
  BX2Y2 As WeightPoint                   'B点
  AB As Double                           '线段AB的长度，A、B两点间的欧氏距离
  BO As Double                           '线段BO的长度
  
  '以下用于解直线方程
  X1EqualX2 As Boolean                   '当AX1Y1.X = BX2Y2.X时True,AB两点所在直线为 x轴值=X1，否则 y轴值=l * x轴值 + d
  l As Double                            'y轴值=l * x轴值 + d
  d As Double                            'y轴值=l * x轴值 + d
  
  '以下用于解二次方程
  a As Double
  b As Double
  c As Double
End Type

Public LineData As LineDataStruct
Public CGOfImagePoints As WeightPoint    '二值图像点阵的重心和重量

Public Sub GetWeightPointOfAAndB()
  Dim DistX As Double, DistY As Double   'A、B两点X、Y方向的街区距离
  
  DistX = LineData.BX2Y2.X - LineData.AX1Y1.X
  DistY = LineData.BX2Y2.Y - LineData.AX1Y1.Y
  LineData.AB = Sqr(DistX * DistX + DistY * DistY)
  LineData.BO = (LineData.AB * LineData.AX1Y1.Weight) / (LineData.AX1Y1.Weight + LineData.BX2Y2.Weight)
  
  If Abs(LineData.AX1Y1.X - LineData.BX2Y2.X) < 0.0000000000001 Then
    LineData.X1EqualX2 = True
    
    LineData.O.X = LineData.AX1Y1.X
    LineData.O.Y = LineData.BX2Y2.Y - Sqr(LineData.BO ^ 2 - DistX ^ 2)
  Else
    LineData.X1EqualX2 = False
    LineData.l = DistY / DistX
    LineData.d = LineData.AX1Y1.Y - LineData.l * LineData.AX1Y1.X
    
    LineData.a = LineData.l ^ 2 + 1
    LineData.b = 2 * (LineData.l * (LineData.d - LineData.BX2Y2.Y) - LineData.BX2Y2.X)
    LineData.c = LineData.BX2Y2.X ^ 2 + (LineData.d - LineData.BX2Y2.Y) ^ 2 - LineData.BO ^ 2
    
    LineData.O.X = (-LineData.b + Sqr(LineData.b ^ 2 - 4 * LineData.a * LineData.c)) / 2 / LineData.a
    If LineData.AX1Y1.X <= LineData.BX2Y2.X Then
      If LineData.O.X >= LineData.BX2Y2.X + 0.0000000000001 Then
        LineData.O.X = (-LineData.b - Sqr(LineData.b ^ 2 - 4 * LineData.a * LineData.c)) / 2 / LineData.a
      End If
    Else
      If LineData.O.X >= LineData.AX1Y1.X + 0.0000000000001 Then
        LineData.O.X = (-LineData.b - Sqr(LineData.b ^ 2 - 4 * LineData.a * LineData.c)) / 2 / LineData.a
      End If
    End If
    LineData.O.Y = LineData.l * LineData.O.X + LineData.d
  End If
  
  LineData.O.Weight = LineData.AX1Y1.Weight + LineData.BX2Y2.Weight
End Sub

另存为Form1.frm文件

VERSION 5.00
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   Caption         =   "Form1"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3090
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "GetCG"
      Height          =   975
      Left            =   2160
      TabIndex        =   1
      Top             =   600
      Width           =   2415
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Init"
      Height          =   1095
      Left            =   2160
      TabIndex        =   0
      Top             =   2040
      Width           =   2535
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private WeightP(100) As WeightPoint

Private Sub Command1_Click()
  Dim i As Long
  
  Randomize CLng(Date) + Timer
  For i = 0 To 3
    WeightP(i).Weight = 500 * Rnd()
    WeightP(i).X = 800 * Rnd()
    WeightP(i).Y = 1000 * Rnd()
  Next i
End Sub

Private Sub Command2_Click()
  Dim i As Long
  
  Let LineData.AX1Y1 = WeightP(0)
  
  For i = 100 To 1 Step -1
    LineData.BX2Y2.Weight = WeightP(i).Weight
    LineData.BX2Y2.X = WeightP(i).X
    LineData.BX2Y2.Y = WeightP(i).Y
    Call GetWeightPointOfAAndB
    Let LineData.AX1Y1 = LineData.O
  Next i
  
  Form1.Print "Weight："; LineData.O.Weight
  Form1.Print "X："; LineData.O.X
  Form1.Print "Y："; LineData.O.Y
End Sub

完整工程下载：http://download.csdn.net/detail/dianyancao/4059483

[贝隆]

这个新颖，只听过物体图形的重心，没有听过二值图的重心

[dianyancao]

刚才调试找到了一个Bug，是LineData.X1EqualX2 = True
时，也需要判断重心位置是否有效。家里不能上网，就不发了