VB获取二值图重心求点评

dianyancao 2012-02-12 07:49:32

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

另存为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