'一个矩形的形状,用以下表示
dim str as string
str="30,-70|50,-70|50,-84|30,-84"
dim jl as long '输入一个值,在str矩形的内部画一个xy坐标都内移jl值的矩形,这个矩形正好套在上个乱形之内。
新得到的矩形的坐标值是"32,-72|48,-72|48,-82|32,-82"
我用的方法是将每个顶点可能发生的四种情况都调用ptinpoly函数判断如果返回0值表示在内部,但是四个值一个都不返回0值,下面的函数是不是有错误啊,高手能不能帮我检查一下,看看有什么问题,或是谁有VB或VBA的代码发表一下,急呀,检查不出问题呀。
它的四种情况是:
x-,y-
x+,y+
x-,y+
x+,y-
这四种情况中应该有一种是在内部的
'判断给定点 pt 是否在多边形 poly 内 '返回 0 在内部,-1 在外面 '返回 > 0 表示点在第几条有向线段上 Private Function PtInPoly(ByVal pt As Variant, ByVal poly As Variant) As Integer Dim i As Integer Dim status, lastStauts As Integer Dim cnt As Integer Dim POS, temp As Integer Dim var_poly As Variant Dim var_polyi As Variant var_poly = Split(poly(1), ",") cnt = 0 lastStauts = IIf(var_poly(1) > pt(1), 1, IIf(var_poly(1) = pt(1), 0, -1)) For i = 1 To UBound(poly) var_poly = Split(poly(i), ",") status = IIf(var_poly(1) > pt(1), 1, IIf(var_poly(1) < pt(1), -1, 0)) temp = status - lastStauts lastStauts = status POS = SideOfLine(poly(i - 1), poly(i), pt) ' 点在有向线段上 var_poly = Split(poly(i), ",") var_polyi = Split(poly(i - 1), ",") If (POS = 0 And (var_polyi(0) <= pt(0) And pt(0) <= var_poly(0) Or var_polyi(0) >= pt(0) And pt(0) >= var_poly(0)) And (var_polyi(1) <= pt(1) And pt(1) <= var_poly(1) Or var_polyi(1) >= pt(1) And pt(1) >= var_poly(1))) Then PtInPoly = i Exit Function End If ' 跨越 If (temp > 0 And POS = 1 Or temp < 0 And POS = -1) Then cnt = cnt + temp End If Next PtInPoly = IIf(cnt = 0, -1, 0) End Function
'判断点在线的哪侧 Private Function SideOfLine(ByVal p1 As Variant, ByVal p2 As Variant, ByVal pt As Variant) As Integer Dim RR, TOP, LL As Integer RR = -1 TOP = 0 LL = 1 Dim c1 As Double Dim c2 As Double Dim var_p1 As Variant Dim var_p2 As Variant var_p1 = Split(p1, ",") var_p2 = Split(p2, ",") c1 = (var_p2(0) - pt(0)) * (pt(1) - var_p1(1)) c2 = (var_p2(1) - pt(1)) * (pt(0) - var_p1(0)) SideOfLine = IIf(c1 > c2, LL, IIf(c1 < c2, RR, TOP)) End Function |