<P>Private Function FindAngle(originPt As MapObjects2.Point, testPt As MapObjects2.Point)</P><P>Dim quadrant As Integer   ' The quadrant that testPt falls into
Dim tmpAngle As Double    ' temporary angle value holder...</P><P>' Given the originPt, find which quadrant the testPt falls in
If testPt.X >= originPt.X And testPt.Y > originPt.Y Then
  quadrant = 1
ElseIf testPt.X > originPt.X And testPt.Y <= originPt.Y Then
  quadrant = 2
ElseIf testPt.X < originPt.X And testPt.Y <= originPt.Y Then
  quadrant = 3
Else
  quadrant = 4
End If
'
' Given the quadrant, calculate the angle
tmpAngle = 90#
Select Case quadrant
  Case 1
    If testPt.X <> originPt.X Then
      tmpAngle = Atn((testPt.Y - originPt.Y) / (testPt.X - originPt.X))
      tmpAngle = Abs(90 - (tmpAngle / 0.01745329))
    End If
  Case 2
    If testPt.Y <> originPt.Y Then
      tmpAngle = Atn((testPt.X - originPt.X) / (originPt.Y - testPt.Y))
      tmpAngle = Abs(90 - (tmpAngle / 0.01745329)) + 90
    End If
  Case 3
    If testPt.X <> originPt.X Then
      tmpAngle = Atn((originPt.Y - testPt.Y) / (originPt.X - testPt.X))
      tmpAngle = Abs(90 - (tmpAngle / 0.01745329)) + 180
    End If
  Case 4
    If testPt.X <> originPt.X Then
      tmpAngle = Atn((originPt.X - testPt.X) / (testPt.Y - originPt.Y))
      tmpAngle = Abs(90 - (tmpAngle / 0.01745329)) + 270
    End If
End Select
FindAngle = tmpAngle
End Function</P>

<P>Private Function UpdateX_Uses(crossnum As Integer, x_uses As MapObjects2.Strings)
' This function manages the x_uses (crossing uses) strings collection, the
'   purpose of which is to record how many times each crossing has been used.
'   If a crossing has been encountered twice, then all polys involved with it
'   have been separated, and there's no need to run BuildSplitPoly loop for it.
'
'  The x_uses strings collection is set up in clusters (similar to strs):
'
'  x_uses(n)  Element   N is the
'  ---------------------------------------------------
'  0          xnumN     index of the crossing
'  1          N         number of times the crossing has been used
'  ---------------------------------------------------</P><P>Dim strIdx As Integer                   ' index into x_uses strings collection
Dim strsTmp As New MapObjects2.Strings  ' strings collection
strsTmp.Unique = False</P><P>Dim uses As Integer             ' number of times a crossing has been used
Dim i As Integer                ' generic index variable
Dim j As Integer                ' ditto</P><P>' Look for the crossing in the strings collection
strIdx = x_uses.Find("xnum" ; str(crossnum))</P><P>If strIdx = -1 Then ' not found... add it, and set number of uses to 1.
  x_uses.Add "xnum" ; str(crossnum)
  x_uses.Add str("1")
Else
  ' crossing has already been added; increment the number of uses
  uses = Val(x_uses(strIdx + 1))
  uses = uses + 1
  ' Modifying a strings collection is a pain...
  ' Remove the strings...
    ' Copy each item in the global Strings
    ' collection to stringsTmp, EXCEPT for
    ' the item we want to drop.
    For j = 0 To x_uses.Count - 1
      If j <> strIdx And j <> strIdx + 1 Then
        strsTmp.Add x_uses(j)
      End If
    Next j
    x_uses.Clear
    For j = 0 To strsTmp.Count - 1
      x_uses.Add strsTmp(j)
    Next j
  '
  ' Add the updated information
  x_uses.Add "xnum" ; str(crossnum)
  x_uses.Add str(uses)
End If
'
Set UpdateX_Uses = x_uses
Set strsTmp = Nothing
End Function</P>

<P>Private Function CalcCentroid(polyShape As Object) As Object</P><P>Dim polyFirstPiece As New MapObjects2.Polygon
Dim ptReturn As New MapObjects2.Point
Dim ptsHoriz As MapObjects2.Points
Dim ptsVert As MapObjects2.Points
Dim lnHoriz As MapObjects2.Line
Dim lnVert As MapObjects2.Line
Dim lnBase As MapObjects2.Line
Dim i As Long</P><P>'Create horizontal and vertical lines that intersect
'the polygon by bi-secting the shape's extent.
polyFirstPiece.Parts.Add polyShape.Parts(0)
Set lnHoriz = MakeBisector(polyFirstPiece, moHorizontal)
Set lnVert = MakeBisector(polyFirstPiece, moVertical)</P><P>'Find the crossing points between the bi-secting
'horizontal line and the polygon
Set ptsHoriz = polyFirstPiece.GetCrossings(lnHoriz)
Set ptsVert = polyFirstPiece.GetCrossings(lnVert)</P><P>'Determine which bi-sector crosses the most.
'Put the centroid in the middle of the first
'pair of crossing points, on the bi-sector
'that crosses the least.
Select Case True
  Case ptsHoriz.Count < ptsVert.Count
    ptReturn.X = (ptsHoriz(0).X + ptsHoriz(1).X) / 2
    ptReturn.Y = ptsHoriz(0).Y
  Case ptsHoriz.Count >= ptsVert.Count
    ptReturn.X = ptsVert(0).X
    ptReturn.Y = (ptsVert(0).Y + ptsVert(1).Y) / 2
End Select</P><P>'Return the calculated centroid to the calling function
Set CalcCentroid = ptReturn
End Function
</P>

<P>Private Function MakeBisector(poly As Object, orientation As Integer) As Object</P><P>Dim rectExtent As MapObjects2.Rectangle
Dim pt1 As New MapObjects2.Point
Dim pt2 As New MapObjects2.Point
Dim pts As New MapObjects2.Points
Dim ln As New MapObjects2.Line</P><P>'Get the polygon's extent
Set rectExtent = poly.Extent</P><P>'Make first and second points of line
Select Case orientation
  Case moHorizontal
    pt1.X = rectExtent.Left
    pt1.Y = rectExtent.Center.Y
    pts.Add pt1
    pt2.X = rectExtent.Right
    pt2.Y = rectExtent.Center.Y
    pts.Add pt2
  Case moVertical
    pt1.X = rectExtent.Center.X
    pt1.Y = rectExtent.Bottom
    pts.Add pt1
    pt2.X = rectExtent.Center.X
    pt2.Y = rectExtent.Top
    pts.Add pt2
End Select
  
'Make horizonal line out of points
ln.Parts.Add pts</P><P>'Return horizontal line to calling function.
Set MakeBisector = ln
End Function</P>

<P>Public Function CheckValidity(poly As MapObjects2.Polygon, sline As MapObjects2.Line)</P><P>Dim seg1 As New MapObjects2.Line
Dim seg2 As New MapObjects2.Line
Dim pts As New MapObjects2.Points</P><P>Dim testLine As New MapObjects2.Line
Dim testPoly As New MapObjects2.Polygon
Dim i As Integer
Dim j As Integer</P><P>CheckValidity = "valid"</P><P>' Checks for Valid Poly and Line '
'
' The splitline must start and end outside the polygon
If poly.IsPointIn(sline.Parts(0).Item(0)) Or poly.IsPointIn(sline.Parts(0).Item(sline.Parts(0).Count - 1)) Then
  CheckValidity = "The SplitPolyWithLine function requires that both" ; _
         vbNewLine ; "ends of the split line fall outside the polygon."
  Exit Function
End If
'
' Check to make sure polygon is a non-self-crossing polygon
Set testPoly = Nothing
Set testPoly = poly.Intersect(poly.Extent)
If testPoly Is Nothing Then
  CheckValidity = "Polygon cannot be split because it is self-crossing."
  Set testPoly = Nothing
  Exit Function
End If
'
' Check to see if polygon is a doughnut poly, which this algorithm can't handle (yet)
Set testPoly = Nothing
For i = 0 To poly.Parts.Count - 1
  testPoly.Parts.Add poly.Parts(i)
  If testPoly.Area < 0 Then
    CheckValidity = "The SplitPolyWithLine function does not currently work with" ; _
           vbNewLine ; "doughnut polygons.  Check the ArcScripts page for updates..."
    Set testPoly = Nothing
    Exit Function
  End If
  testPoly.Parts.Remove 0
Next i
'
' Check to make sure splitLine does not self crossing inside the poly
Set testLine = poly.Intersect(sline)
For i = 0 To testLine.Parts.Count - 1
  seg1.Parts.Add testLine.Parts(i)
  For j = 1 To testLine.Parts.Count - 1
    If Abs(i - j) >= 2 Then
      seg2.Parts.Add testLine.Parts(j)
      Set pts = seg1.GetCrossings(seg2)
      If pts.Count > 0 Then
        CheckValidity = "Invalid split line.  The split line must " ; vbNewLine _
                        ; "not cross itself within the polygon."
        Set seg1 = Nothing
        Set seg2 = Nothing
        Set testLine = Nothing
        Set testPoly = Nothing
        Exit Function
      End If
      seg2.Parts.Remove 0
    End If
  Next j
  seg1.Parts.Remove 0
Next i
End Function
</P>

<P>非常感谢各位不吝赐教，楼上的代码小弟也研究过，不甚理想，需要指出的是代码</P><P>中多处用到union,intersect等mo中求集、并、交的方法，根据小弟测试，此类方法</P><P>不太稳定，且返回的图形间top关系及差（用上述方法打断的面会在交线处发生偏移），大家不防一试。小弟近日在研究如何在mo下进行构面，不知大家有什么好的算法，一起讨论讨论。小第在此先谢过了！</P>

<img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em01.gif" />

<img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em08.gif" />

<img src="images/post/smile/dvbbs/em02.gif" />