袁绍伦
路人甲
路人甲
  • 注册日期2003-08-08
  • 发帖数654
  • QQ164646905
  • 铜币1336枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:1477回复:1

我自己做的函数,用 line  切割 polygon.

楼主#
更多 发布于:2004-03-25 10:23
程序思路:
将一个 trackingline 设置为一个 line,然后将 line 和由 trackingline 选中的 polygon 作为两个参数传递给一个 cut_one_two 函数,函数返回值为一个复 parts 的 polygon ,其有 2 个 单 part 的 polygon。到次,切割任务完成,然后执行新建立一个 shp 文件,把切割后形成的 polygon 保存到 shp 文件里!
主要函数:
Cut_one_two:
进行多边形切割!
Syntax:
cut_one_two(poly As MapObjects2.Polygon, line As MapObjects2.line) As MapObjects2.Polygon
Arguments:
Poly: is a mapobjects2.polygon(object)
Line: is a mapobjects2.line(object)
Return Types:
Mapobjects2.polygon
Remarks:
Poly is a single-part polygon , but the returned object is a mul-part polygon contains 2 .
Examples:
Dim my_poly as mapobjects2.polygon,mline as mapobjects2.line,mpoly as mapobjects2.polygon
Set my_poly=cut_one_two(mpoly,mline)
The concrete realization:
Public Function cut_one_two(poly As MapObjects2.Polygon, line As MapObjects2.line) As MapObjects2.Polygon

    Dim pts_poly As MapObjects2.Points, pts_cross As MapObjects2.Points, pts_line As MapObjects2.Points
    Dim a As Integer, b As Integer
    Dim firstpoly As Integer, lastpoly As Integer, firstline As Integer, lastline As Integer
    Dim shunxu As Boolean, firstpoint As MapObjects2.Point, lastpoint As MapObjects2.Point
    Dim i As Integer, j As Integer
    Dim my_poly As New MapObjects2.Polygon, my_pts1 As New MapObjects2.Points, my_pts2 As New MapObjects2.Points
    
    Set pts_cross = line.GetCrossings(poly)
    If pts_cross.Count <> 2 Then
        MsgBox "直线与多边形并非 2 个交点,无法分割,请重新确定切割直线!"
        Set my_line = Nothing
        Set my_polygon = Nothing
        Set okpoly = Nothing
        Map1.TrackingLayer.Refresh True
        Exit Function
    End If
    Set pts_poly = poly.Parts.Item(0)
    Set pts_line = line.Parts.Item(0)
    
    If poly.IsPointIn(pts_line.Item(0)) Then
        MsgBox "Line 的第一个点在多边形内,无法进行切割,请重新确定切割直线!"
        Set my_line = Nothing
        Set my_polygon = Nothing
        Set okpoly = Nothing
        Map1.TrackingLayer.Refresh True
        Exit Function
    End If
    
'''''''''''''''''''''''''''确定 2 个相关 integer 值! 这 2 个 integer 值是交点前的多边形的索引号!
    For i = 0 To pts_poly.Count - 1
        If i + 1 < pts_poly.Count Then
        
            If (Abs((pts_poly(i + 1).y - pts_poly(i).y) * (pts_cross(0).x - pts_poly(i).x) - (pts_poly(i + 1).x - pts_poly(i).x) * (pts_cross(0).y - pts_poly(i).y)) < 0.0001) And ((pts_poly(i).x <= pts_cross(0).x And pts_cross(0).x <= pts_poly(i + 1).x) Or (pts_poly(i + 1).x <= pts_cross(0).x And pts_cross(0).x <= pts_poly(i).x)) Then
                a = i
            End If
            If (Abs((pts_poly(i + 1).y - pts_poly(i).y) * (pts_cross(1).x - pts_poly(i).x) - (pts_poly(i + 1).x - pts_poly(i).x) * (pts_cross(1).y - pts_poly(i).y)) < 0.0001) And ((pts_poly(i).x <= pts_cross(1).x And pts_cross(1).x <= pts_poly(i + 1).x) Or (pts_poly(i + 1).x <= pts_cross(1).x And pts_cross(1).x <= pts_poly(i).x)) Then
                b = i
            End If
            
        ElseIf i + 1 = pts_poly.Count Then
        
            If (Abs((pts_poly(0).y - pts_poly(i).y) * (pts_cross(0).x - pts_poly(i).x) - (pts_poly(0).x - pts_poly(i).x) * (pts_cross(0).y - pts_poly(i).y)) < 0.0001) And ((pts_poly(i).x <= pts_cross(0).x And pts_cross(0).x <= pts_poly(0).x) Or (pts_poly(0).x <= pts_cross(0).x And pts_cross(0).x <= pts_poly(i).x)) Then
                a = i
            End If
            If (Abs((pts_poly(0).y - pts_poly(i).y) * (pts_cross(1).x - pts_poly(i).x) - (pts_poly(0).x - pts_poly(i).x) * (pts_cross(1).y - pts_poly(i).y)) < 0.0001) And ((pts_poly(i).x <= pts_cross(1).x And pts_cross(1).x <= pts_poly(0).x) Or (pts_poly(0).x <= pts_cross(1).x And pts_cross(1).x <= pts_poly(i).x)) Then
                b = i
            End If
            
        End If
    Next
    
''''''''''''''''''找出小的索引号,并确定多边形先遇到的点!
    If a = b Then
        firstpoly = a: lastpoly = b
        Set firstpoint = pts_cross(0)
        Set lastpoint = pts_cross(1)
    ElseIf a < b Then
        firstpoly = a: lastpoly = b
        Set firstpoint = pts_cross(0)
        Set lastpoint = pts_cross(1)
    ElseIf a > b Then
        firstpoly = b: lastpoly = a
        Set firstpoint = pts_cross(1)
        Set lastpoint = pts_cross(0)
    End If
    
''''''''''''''''''''''''''找出交点在线上前面的索引
    For i = 0 To pts_line.Count - 2
        If (Abs((pts_line(i + 1).y - pts_line(i).y) * (firstpoint.x - pts_line(i).x) - (pts_line(i + 1).x - pts_line(i).x) * (firstpoint.y - pts_line(i).y)) < 0.0001) And ((pts_line(i).x <= firstpoint.x And firstpoint.x <= pts_line(i + 1).x) Or (pts_line(i + 1).x <= firstpoint.x And firstpoint.x <= pts_line(i).x)) Then
            firstline = i
        End If
        If (Abs((pts_line(i + 1).y - pts_line(i).y) * (lastpoint.x - pts_line(i).x) - (pts_line(i + 1).x - pts_line(i).x) * (lastpoint.y - pts_line(i).y)) < 0.0001) And ((pts_line(i).x <= lastpoint.x And lastpoint.x <= pts_line(i + 1).x) Or (pts_line(i + 1).x <= lastpoint.x And lastpoint.x <= pts_line(i).x)) Then
            lastline = i
        End If
    Next
    
'''''''''''''''''定义一个 boolean 型变量,来区分 线 上点加载顺序。
    If firstline < lastline Then shunxu = True
    If firstline > lastline Then shunxu = False
    
''''''''''''''''''''将一系列点分别赋值给两个多边形!
    For i = 0 To pts_poly.Count - lastpoly + firstpoly - 1
        If i < firstpoly Then
            my_pts1.Add pts_poly(i)
        ElseIf i = firstpoly Then
            
            my_pts1.Add pts_poly(i)
            my_pts1.Add firstpoint
            If shunxu = True Then
                For j = firstline + 1 To lastline
                    my_pts1.Add pts_line(j)
                Next
            Else
                For j = firstline To lastline + 1 Step -1
                    my_pts1.Add pts_line(j)
                Next
            End If
            my_pts1.Add lastpoint
                            
        ElseIf i > firstpoly Then
            my_pts1.Add pts_poly(i + lastpoly - firstpoly)
        End If
    Next
    
    If firstpoly <> lastpoly Then
        For i = 1 To lastpoly - firstpoly + 2
            If i < lastpoly - firstpoly Then
                my_pts2.Add pts_poly(i + firstpoly)
            ElseIf i = lastpoly - firstpoly Then
                my_pts2.Add pts_poly(i + firstpoly)
                my_pts2.Add lastpoint
                If shunxu = True Then
                    For j = lastline To firstline + 1 Step -1
                        my_pts2.Add pts_line(j)
                    Next
                Else
                    For j = lastline + 1 To firstline
                        my_pts2.Add pts_line(j)
                    Next
                End If
                my_pts2.Add firstpoint
            End If
        Next
    Else
        my_pts2.Add lastpoint
        If shunxu = True Then
            For j = lastline To firstline + 1 Step -1
                my_pts2.Add pts_line(j)
            Next
        Else
            For j = lastline + 1 To firstline
                my_pts2.Add pts_line(j)
            Next
        End If
        my_pts2.Add firstpoint
    End If
    
    my_poly.Parts.Add my_pts1
    my_poly.Parts.Add my_pts2
    
    Set cut_one_two = my_poly
End Function

喜欢0 评分0
愿意和大家交朋友! QQ:47559983 MSN:shaolun_yuan@hotmail.com eMail:shaolun-yuan@163.com
jay100125
路人甲
路人甲
  • 注册日期2007-06-13
  • 发帖数53
  • QQ
  • 铜币246枚
  • 威望0点
  • 贡献值0点
  • 银元0个
1楼#
发布于:2009-03-07 14:05
god   有c#的么。。。
举报 回复(0) 喜欢(0)     评分
游客

返回顶部