misters 发表于 2006-1-12 19:03:00

[求助]判断点在闭合区域内部，代码有问题，高手帮忙

<P>'一个矩形的形状，用以下表示</P>
<P>dim str as string</P>
<P>str="30,-70|50,-70|50,-84|30,-84"</P>
<P>dim jl as long '输入一个值，在str矩形的内部画一个xy坐标都内移jl值的矩形，这个矩形正好套在上个乱形之内。</P>
<P>新得到的矩形的坐标值是"32,-72|48,-72|48,-82|32,-82"</P>
<P>我用的方法是将每个顶点可能发生的四种情况都调用ptinpoly函数判断如果返回0值表示在内部，但是四个值一个都不返回0值，下面的函数是不是有错误啊，高手能不能帮我检查一下，看看有什么问题，或是谁有VB或VBA的代码发表一下，急呀，检查不出问题呀。</P>
<P>它的四种情况是：</P>
<P>x-,y-</P>
<P>x+,y+</P>
<P>x-,y+</P>
<P>x+,y-</P>
<P>这四种情况中应该有一种是在内部的</P>

<P><BR>'判断给定点 pt 是否在多边形 poly 内<BR>'返回 0 在内部，-1 在外面<BR>'返回 &gt; 0 表示点在第几条有向线段上<BR>Private Function PtInPoly(ByVal pt As Variant, ByVal poly As Variant) As Integer<BR>&nbsp;&nbsp;&nbsp; Dim i As Integer<BR>&nbsp;&nbsp;&nbsp; Dim status, lastStauts As Integer<BR>&nbsp;&nbsp;&nbsp; Dim cnt As Integer<BR>&nbsp;&nbsp;&nbsp; Dim POS, temp As Integer<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; Dim var_poly As Variant<BR>&nbsp;&nbsp;&nbsp; Dim var_polyi As Variant<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; var_poly = Split(poly(1), ",")<BR>&nbsp;&nbsp;&nbsp; cnt = 0<BR>&nbsp;&nbsp;&nbsp; lastStauts = IIf(var_poly(1) &gt; pt(1), 1, IIf(var_poly(1) = pt(1), 0, -1))<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; For i = 1 To UBound(poly)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; var_poly = Split(poly(i), ",")<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; status = IIf(var_poly(1) &gt; pt(1), 1, IIf(var_poly(1) &lt; pt(1), -1, 0))<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; temp = status - lastStauts<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; lastStauts = status<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; POS = SideOfLine(poly(i - 1), poly(i), pt)<BR>'&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 点在有向线段上<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; var_poly = Split(poly(i), ",")<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; var_polyi = Split(poly(i - 1), ",")<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If (POS = 0 And (var_polyi(0) &lt;= pt(0) And pt(0) &lt;= var_poly(0) Or var_polyi(0) &gt;= pt(0) And pt(0) &gt;= var_poly(0)) And (var_polyi(1) &lt;= pt(1) And pt(1) &lt;= var_poly(1) Or var_polyi(1) &gt;= pt(1) And pt(1) &gt;= var_poly(1))) Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; PtInPoly = i<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exit Function<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>'&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 跨越<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If (temp &gt; 0 And POS = 1 Or temp &lt; 0 And POS = -1) Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; cnt = cnt + temp<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; Next<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; PtInPoly = IIf(cnt = 0, -1, 0)<BR>&nbsp;&nbsp;&nbsp; <BR>End Function</P>
<P>'判断点在线的哪侧<BR>Private Function SideOfLine(ByVal p1 As Variant, ByVal p2 As Variant, ByVal pt As Variant) As Integer<BR>&nbsp;&nbsp;&nbsp; Dim RR, TOP, LL As Integer<BR>&nbsp;&nbsp;&nbsp; RR = -1<BR>&nbsp;&nbsp;&nbsp; TOP = 0<BR>&nbsp;&nbsp;&nbsp; LL = 1<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; Dim c1 As Double<BR>&nbsp;&nbsp;&nbsp; Dim c2 As Double<BR>&nbsp;&nbsp;&nbsp; Dim var_p1 As Variant<BR>&nbsp;&nbsp;&nbsp; Dim var_p2 As Variant<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; var_p1 = Split(p1, ",")<BR>&nbsp;&nbsp;&nbsp; var_p2 = Split(p2, ",")<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; c1 = (var_p2(0) - pt(0)) * (pt(1) - var_p1(1))<BR>&nbsp;&nbsp;&nbsp; c2 = (var_p2(1) - pt(1)) * (pt(0) - var_p1(0))<BR>&nbsp;&nbsp;&nbsp; SideOfLine = IIf(c1 &gt; c2, LL, IIf(c1 &lt; c2, RR, TOP))<BR>End Function</P>
页: [1]
查看完整版本: [求助]判断点在闭合区域内部，代码有问题，高手帮忙