放一段代码在这，不解释..._拔剑-浆糊的传说_新浪博客

Dim x(30000) As Double

Dim y(30000) As Double

Dim need(30000) As Boolean

Dim NUM As Integer

Const MAX = 3

Function distance(x1, y1, x2, y2)

   dx = x1 - x2

   dy = y1 - y2

   d = dx * dx + dy * dy

   distance = Sqr(d)

End Function

Function dist_p_to_line(px, py, x1, y1, x2, y2) As Double

    t = 0  'If t is (0,1) then return 1,else the verticle point is not in The two endpoint

    t = ((y2 - y1) * (py - y1) + (x2 - x1) * (px - x1))

    t = t / ((y2 - y1) * (y2 - y1) + (x2 - x1) * (x2 - x1))

    DestinePointx = x1 + (x2 - x1) * t

    DestinePointy = y1 + (y2 - y1) * t

        dx = px - DestinePointx

        dy = py - DestinePointy

 

        dist = dx * dx + dy * dy

        dist_p_to_line = Sqr(dist)

End Function

'

' 在(时间-x)空间精简

'

Sub DP_X(down, up)

   max_pos = down

   max_val = 0

   

   ' find the max position

   For i = down + 1 To up - 1

       dist = dist_p_to_line(i, x(i), down, x(down), up, x(up))

       If dist > max_val Then

           max_val = dist

           max_pos = i

       End If

   Next i

   

   If max_val < MAX Then

      For i = down + 1 To up - 1

          Sheet2.Cells(i, 4) = 0

      Next i

   Else

      Sheet2.Cells(down, 4) = 1

      Sheet2.Cells(up, 4) = 1

      Sheet2.Cells(max_pos, 4) = 1

      DP_X down, max_pos

      DP_X max_pos, up

   End If

   

End Sub

'

' 在(时间-y)空间精简

'

Sub DP_Y(down, up)

   max_pos = down

   max_val = 0

   

  ' find the max position

   For i = down + 1 To up - 1

       dist = dist_p_to_line(i, y(i), down, y(down), up, y(up))

       If dist > max_val Then

           max_val = dist

           max_pos = i

       End If

   Next i

   

   If max_val < MAX Then

      For i = down + 1 To up - 1

          Sheet2.Cells(i, 5) = 0

      Next i

      Sheet2.Cells(down, 5) = 1

      Sheet2.Cells(up, 5) = 1

   Else

      Sheet2.Cells(down, 5) = 1

      Sheet2.Cells(up, 5) = 1

      Sheet2.Cells(max_pos, 5) = 1

      DP_Y down, max_pos

      DP_Y max_pos, up

   End If

   

End Sub

Sub init()

  

    ' 1. add 帧号

    NUM = 0

        For i = 1 To 30000

            x(i) = Sheet2.Cells(i, 2)

            y(i) = Sheet2.Cells(i, 3)

            If Sheet2.Cells(i, 2) <> "" Then

                NUM = NUM + 1

                Sheet2.Cells(i, 1) = NUM

            Else

                GoTo INIT_NEED

            End If

         

        Next i

        

INIT_NEED:

    '2. 清除原来的数据

    For i = 1 To NUM

         For j = 4 To 9

              Sheet2.Cells(i, j) = ""

         Next j

    Next i

    

    'run DP

         DP_X 1, NUM

         DP_Y 1, NUM

    

    'now copy data to new columns

    ' 第四行1，表x方向的关键帧

    ' 第5行为1，表示y方向的关键帧

         j = 1

    For i = 1 To NUM

          If Sheet2.Cells(i, 4) = 1 Then

              Sheet2.Cells(j, 6) = i

              Sheet2.Cells(j, 7) = x(i)

              j = j + 1

          End If

    Next i

         

    j = 1

    For i = 1 To NUM

          If Sheet2.Cells(i, 5) = 1 Then

              Sheet2.Cells(j, 8) = i

              Sheet2.Cells(j, 9) = y(i)

              j = j + 1

          End If

    Next i

    

    ' 现在搜寻预置位区间，它肯定是t-x, t-y静止区域的交集

    Dim tfromx(20) As Integer      ' x

    Dim ttox(20) As Integer

    Dim xposnum As Integer

    

    

    Dim tfromy(20) As Integer      ' x

    Dim ttoy(20) As Integer

    Dim yposnum As Integer

    xposnum = 0

    yposnum = 0

    

    ' no time la,ingore the code please, maybe later I will update it since I have proved the basic principle

End Sub

Sub test2()

    dist11 = dist_p_to_line(0, 5, 0, 1, 3, 5)

End Sub