乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 10|回复: 0

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

[复制链接]

10

主题

19

帖子

1

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
59
发表于 2006-1-12 19:03:00 | 显示全部楼层 |阅读模式
'一个矩形的形状,用以下表示
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(0) And pt(0) >= var_poly(0)) And (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
'判断点在线的哪侧
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
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-5 01:20 , Processed in 0.503853 second(s), 66 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表