Board logo

標題: [發問] 落點問題....(我目前從未到過的領域) [打印本頁]
作者: ui123    時間: 2013-11-11 19:47     標題: 落點問題....(我目前從未到過的領域)

本帖最後由 ui123 於 2013-11-11 19:48 編輯

今天我跟同事2人在吃飯時，同事跟我討論了下面的問題:


---------------------------------------------------------------------------------------

我同事說:主管最近出了個超難題給她，題目如附件，然後就丟了很多data請她分類

                   大概1000筆左右(X,y軸點......"更恐怖的事" 是不一定是整數，還有小數點的)

她說，她很笨，只會一筆一筆對在哪一個區域，就這樣一直對下去......然後我也幫她對了很久

我只會正方形區域然後用if ....但這似乎行不通~今天加了一點班後終於完成了  ^^~開心

---------------------------------------------------------------------------------------


目前也只能這樣~

如果大家遇到跟我一樣的狀況會怎麼樣呢?

附件如下:
[attach]16670[/attach]
作者: ML089    時間: 2013-11-12 14:13

A、C區給的座標點為封閉線段，比較容易處理
B區感覺也是四邊形好像在A、C區下方，座標點不是封閉線段需要補點或額外處理
B區的描述可否另行補點(座標)處理

原則上四邊封閉區域可以用中心與檢查點連一直線，檢查與四邊線是否相交，全部沒有相交就是在裡面，與任一線相交表示在外面。

等我明天回來再詳細研究
作者: stillfish00    時間: 2013-11-12 20:41

回復 1# ui123
B區補完(6,6),(5,5)形成凹多邊形
判斷的演算法可以參考 http://www.csie.ntnu.edu.tw/~u91029/Polygon.html
裡面 判斷一個點是否在簡單多邊形內部裡面 這一段
作者: ui123    時間: 2013-11-12 22:03

回復 3# stillfish00
stillfish00 大  ~有看到你附的網站，謝謝!  好多奇奇怪怪的圖~(@[]@!!)
如果這個例子(附件中在M，N欄的座標)要用VBA寫成是不是會非常非常的複雜?
我看他的函數看起來不是VBA的函數寫成的?  非常陌生， VBA的函數有這些功能?!
[attach]16678[/attach]
作者: ui123    時間: 2013-11-12 22:18

回復 2# ML089
ML089大~
B區的描述可否另行補點(座標)處理?   可以的，這樣也比較合理，且ABC區無交集
也就是說，如果剛好在重疊的線上，取較小那一個(A<B<C)，例如，剛好在A區及B區交接線上，算A區的
下面有另附例子，stillfish00 大說的好難，這種問題用"VBA函數"可以寫的出來嗎?!
網路上我找不到VBA寫的例子~
只是我也很好奇VBA是否能解決此類問題，這種問題感覺很簡單，但似乎超難判斷的!~
大家可以想一想，謝謝!
作者: stillfish00    時間: 2013-11-13 00:14

本帖最後由 stillfish00 於 2013-11-13 00:27 編輯

回復 4# ui123
他是C/C++寫的，改成VBA大約如下
  1. Function pointInPoly(ptx As Double, pty As Double, arPoly) As Boolean
  2.     Dim i As Long, j As Long
  3.     Dim pix As Double, piy As Double
  4.     Dim pjx As Double, pjy As Double
  5.    
  6.     For i = 1 To UBound(arPoly) - 1
  7.         j = i + 1
  8.         pix = arPoly(i, 1): piy = arPoly(i, 2)
  9.         pjx = arPoly(j, 1): pjy = arPoly(j, 2)
  10.         
  11.         '不包含點在多邊形線上
  12.         If Not (piy > pty) = (pjy > pty) Then
  13.             If ptx < (pjx - pix) * (pty - piy) / (pjy - piy) + pix Then pointInPoly = Not pointInPoly
  14.         End If
  15.     Next
  16. End Function
複製代碼
利用他寫一個自訂函數RegionABC
  1. Function RegionABC(x As Double, y As Double, RegionA As Range, RegionB As Range, RegionC As Range) As String
  2.     '不包含點在ABC邊緣
  3.     If pointInPoly(x, y, RegionA.Value) Then RegionABC = "A": Exit Function
  4.     If pointInPoly(x, y, RegionB.Value) Then RegionABC = "B": Exit Function
  5.     If pointInPoly(x, y, RegionC.Value) Then RegionABC = "C": Exit Function
  6.     RegionABC = "不在ABC"
  7. End Function
複製代碼
先補齊B區的點，
使用，例如在O4公式打上  "=RegionABC(M4,N4,$C$4:$D$8,$C$10:$D$16,$C$18:$D$22)"
作者: ML089    時間: 2013-11-13 20:28

回復 3# stillfish00


  stillfish00大提供的資料很完整，謝謝你提供那麼完整的網頁資訊。
作者: ML089    時間: 2013-11-13 20:29

回復 6# stillfish00


    鼓勵一下，C語言改為VBA，剛好可以參考，謝謝
作者: ML089    時間: 2013-11-13 20:38

回復 5# ui123

stillfish00 大的功力高強，使用自訂函數應該最好的方式

網頁中所述的方法比我講的考慮方法還要正確

判斷一個點是否在簡單多邊形內部
從給定點開始，往隨便一個方向（實作時習慣水平往右）射出一條無限長射線，看看穿過多少條邊。如果穿過偶數次，表示點在簡單多邊形外部；如果穿過奇數次，表示點在簡單多邊形內部。
要小心處理射線穿過頂點、射線與邊重疊的情況。也要小心處理點在多邊形邊界上的情況。
時間複雜度為 O(N) ， N 為簡單多邊形的頂點數目。

我再來研究可否用公式決解，但會比VBA看起來更複雜。
作者: ML089    時間: 2013-11-13 20:49

回復 6# stillfish00

不好意思，借該版資料

stillfish00大:
可否請你再幫忙寫 A、B、C等區域面積的自訂函數，感恩。
作者: ui123    時間: 2013-11-14 06:58

回復 6# stillfish00

stillfish00大 好神，原來那是C 語言喔!

竟然可以改寫成VBA~真是厲害耶~

也謝謝ML089的參與^^~
作者: stillfish00    時間: 2013-11-14 12:06

回復 10# ML089
自訂函數
  1. Function PolyArea(rngPoly As Range)
  2.     Dim i As Long, j As Long
  3.     Dim pix As Double, piy As Double
  4.     Dim pjx As Double, pjy As Double
  5.     Dim arPoly, area As Double
  6.         
  7.     arPoly = rngPoly.Value
  8.     If UBound(arPoly, 2) <> 2 _
  9.         Or arPoly(1, 1) <> arPoly(UBound(arPoly), 1) _
  10.         Or arPoly(1, 2) <> arPoly(UBound(arPoly), 2) Then PolyArea = CVErr(xlErrRef): Exit Function
  11.    
  12.     area = 0
  13.     For i = 1 To UBound(arPoly) - 1
  14.         j = i + 1
  15.         pix = arPoly(i, 1): piy = arPoly(i, 2)
  16.         pjx = arPoly(j, 1): pjy = arPoly(j, 2)
  17.         
  18.         area = area + pix * pjy
  19.         area = area - piy * pjx
  20.     Next
  21.     PolyArea = Abs(area) / 2
  22. End Function
複製代碼
作者: ML089    時間: 2013-11-14 12:43

回復 12# stillfish00


收到了，感謝萬分
初步測試 OK

我們工程設計要算一些面積、形心、慣性矩Ix、 Iy、Ixy 等
程式都是DOS時期FORTRAN寫的，在WIN7、WIN8系統無法執行(越來越不相容)。
剛想轉為EXCEL VBA來處理，看來你已經幫我完成第一步了，感謝。
作者: ui123    時間: 2013-11-14 19:30

回復 12# stillfish00
stillfish00大 超厲害，真是天才耶~
我好好的研究一下，真的謝謝!   相信以後你有需要，別人也一定會幫你的^^~
作者: ui123    時間: 2013-11-14 19:54

b]回復 12# stillfish00

stillfish00 大您好，我剛剛用了一下你的自訂函數(第一次用這個)
但我不知道怎麼用，那個函數沒有說明?! 無法判出，如附件，拜託教教我<(_ _)>
還是有其他人會用了? ML089大?  感恩~
P.S.我還無法下載檔案

[attach]16697[/attach]
作者: ML089    時間: 2013-11-14 20:01

回復 15# ui123

程式放在 Module1
A區面積 =PolyArea(C4:D8)
作者: ui123    時間: 2013-11-14 20:17

回復 16# ML089

ML089 大~  O4 儲存和下面的公式怎麼填，無法判出ABC區???，拜託幫我看一下，謝謝你^^
公式已放在裡面了，如附件(1小時回復3次用光了 :'( )
[attach]16699[/attach]
作者: ui123    時間: 2013-11-14 20:37

回復 12# stillfish00
成功了，判定出ABC區了 ~Ya^^   謝謝stillfish00大 及ML089大

問一下stillfish00大 及ML089大
1)包含點在ABC邊緣線上怎麼辦?(採取如果剛好在重疊的線上，取較小那一個(A<B<C)，例如，剛好在A區及B區交接線上，算A區的)
2)這個可以用在多邊形嗎? 有些"不規則的多邊形"呢?
3)還是不懂 A區面積 =PolyArea(C4:D8) 是要做什麼?
感謝萬分<(_ _)>
作者: ui123    時間: 2013-11-14 21:07

回復 12# stillfish00

關於剛剛的問題 for stillfish00大 及ML089大

1)包含點在ABC邊緣線上怎麼辦?(採取如果剛好在重疊的線上，取較小那一個(A<B<C)，例如，剛好在A區及B區交接線上，算A區的)
    Ans:重疊線上，會判皆沒再ABC區上

2)這個可以用在多邊形嗎? 有些"不規則的多邊形"呢?
    Ans:"應用性非常廣"，且可以對任何多邊形無限增加區域~超級厲害

3)還是不懂 A區面積 =PolyArea(C4:D8) 是要做什麼?
    Ans:還是不懂這要做什麼 @@ 可以解說一下功能嗎? 感恩

stillfish00大，可以想出判重疊線嗎?
缺臨門一腳了!
如果重疊線可判出，就非常"完美了"，不然會漏判掉很多線上點~
剛剛使用心得，超實用 再次謝謝  stillfish00大
作者: stillfish00    時間: 2013-11-14 22:11

回復 19# ui123
修改如下，可含邊上的點，有優先順序(靠前的優先)
區域不限ABC三區可在參數自行增加，但要依參數順序。
  1. Function pointInPoly(ptx As Double, pty As Double, arPoly) As Boolean
  2.     Dim i As Long, j As Long
  3.     Dim pix As Double, piy As Double
  4.     Dim pjx As Double, pjy As Double
  5.    
  6.     For i = 1 To UBound(arPoly) - 1
  7.         j = i + 1
  8.         pix = arPoly(i, 1): piy = arPoly(i, 2)
  9.         pjx = arPoly(j, 1): pjy = arPoly(j, 2)
  10.         
  11.         '多邊形邊上
  12.         If (pix - ptx) * (pjy - pty) - (piy - pty) * (pjx - ptx) = 0 And _
  13.             (pix - ptx) * (pjx - ptx) + (piy - pty) * (pjy - pty) <= 0 Then _
  14.         pointInPoly = True: Exit Function
  15.         
  16.         '多邊形內部
  17.         If Not (piy > pty) = (pjy > pty) Then
  18.             If ptx < (pjx - pix) * (pty - piy) / (pjy - piy) + pix Then pointInPoly = Not pointInPoly
  19.         End If
  20.     Next
  21. End Function

  23. Function RegionABC(x As Double, y As Double, ParamArray polyRegion())
  24.     '3rd參數為A區，4th參數為B區。。。依此類推，越靠前的優先。
  25.     Dim i As Long, arPoly
  26.         
  27.     For i = LBound(polyRegion) To UBound(polyRegion)
  28.         arPoly = polyRegion(i).Value
  29.         
  30.         If UBound(arPoly, 2) <> 2 _
  31.             Or arPoly(1, 1) <> arPoly(UBound(arPoly), 1) _
  32.             Or arPoly(1, 2) <> arPoly(UBound(arPoly), 2) Then RegionABC = CVErr(xlErrRef): Exit Function
  33.         
  34.         If pointInPoly(x, y, arPoly) Then
  35.             RegionABC = Chr(65 + i - LBound(polyRegion))    '依順位顯示A，B，C，D
  36.             Exit Function
  37.         End If
  38.     Next i
  39.     RegionABC = "不在範圍內"
  40. End Function
複製代碼
作者: stillfish00    時間: 2013-11-14 22:26

回復 19# ui123
A區面積 =PolyArea(C4:D8)
這只是ML089大在10樓要我另外幫忙寫的算面積的函數。
作者: ui123    時間: 2013-11-14 22:43

回復 20# stillfish00
stillfish00大~ 試過，成功~ 給你拍拍手
非常完美的結果，好厲害，原本真的以為用VBA應該解不出來，結果"竟然被解出來了!"
超強的，真的非常謝謝你，祝你工作超順利  \(^0^)/

P.S.還有謝謝參與的ML089大，因為有你的參與，所以這個文章有了多人討論的感覺，不會顯得這麼孤單~謝謝你^^
作者: checkout88    時間: 2022-10-16 16:03

回復 21# stillfish00


    因為權限不足, 無法私訊. 但還是要特地來這裡感謝 stillfish00 大大.  用這段程式用經緯度跟 google map 的座標圖搭配之後, 就可以用VBA來判斷房屋的座落點, 十分好用.  謝謝.



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)