阅读:1636回复:1
我自己做的函数,用 line 切割 polygon.
程序思路:
将一个 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 |
|
|
1楼#
发布于:2009-03-07 14:05
god 有c#的么。。。
|
|