123
返回列表 上一主題 發帖

[發問] 落點問題....(我目前從未到過的領域)

ui123

帖子
73 
主題
11 
精華
0 
積分
100 
點名
0  
作業系統
Win 8 
軟體版本
2007 
閱讀權限
20 
性別
女 
註冊時間
2013-5-11 
最後登錄
2018-7-25 

論壇榮譽勳章論壇贊助勳章
11# 跳轉到 »
發表於 2013-11-14 06:58 | 只看該作者
回復 6# stillfish00

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

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

也謝謝ML089的參與^^~

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
12#
發表於 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
複製代碼

TOP

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
13#
發表於 2013-11-14 12:43 | 只看該作者
回復 12# stillfish00


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

我們工程設計要算一些面積、形心、慣性矩Ix、 Iy、Ixy 等
程式都是DOS時期FORTRAN寫的，在WIN7、WIN8系統無法執行(越來越不相容)。
剛想轉為EXCEL VBA來處理，看來你已經幫我完成第一步了，感謝。
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

ui123

帖子
73 
主題
11 
精華
0 
積分
100 
點名
0  
作業系統
Win 8 
軟體版本
2007 
閱讀權限
20 
性別
女 
註冊時間
2013-5-11 
最後登錄
2018-7-25 

論壇榮譽勳章論壇贊助勳章
14#
發表於 2013-11-14 19:30 | 只看該作者
回復 12# stillfish00
stillfish00大 超厲害，真是天才耶~
我好好的研究一下，真的謝謝!   相信以後你有需要，別人也一定會幫你的^^~

TOP

ui123

帖子
73 
主題
11 
精華
0 
積分
100 
點名
0  
作業系統
Win 8 
軟體版本
2007 
閱讀權限
20 
性別
女 
註冊時間
2013-5-11 
最後登錄
2018-7-25 

論壇榮譽勳章論壇贊助勳章
15#
發表於 2013-11-14 19:54 | 只看該作者
b]回復 12# stillfish00

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

落點問題_判斷例子_.rar (17.73 KB)

TOP

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
16#
發表於 2013-11-14 20:01 | 只看該作者
回復 15# ui123

程式放在 Module1
A區面積 =PolyArea(C4:D8)
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

ui123

帖子
73 
主題
11 
精華
0 
積分
100 
點名
0  
作業系統
Win 8 
軟體版本
2007 
閱讀權限
20 
性別
女 
註冊時間
2013-5-11 
最後登錄
2018-7-25 

論壇榮譽勳章論壇贊助勳章
17#
發表於 2013-11-14 20:17 | 只看該作者
回復 16# ML089

ML089 大~  O4 儲存和下面的公式怎麼填，無法判出ABC區???，拜託幫我看一下，謝謝你^^
公式已放在裡面了，如附件(1小時回復3次用光了 :'( )
落點問題_判斷例子_try2.rar (18.36 KB)

TOP

ui123

帖子
73 
主題
11 
精華
0 
積分
100 
點名
0  
作業系統
Win 8 
軟體版本
2007 
閱讀權限
20 
性別
女 
註冊時間
2013-5-11 
最後登錄
2018-7-25 

論壇榮譽勳章論壇贊助勳章
18#
發表於 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) 是要做什麼?
感謝萬分<(_ _)>

TOP

ui123

帖子
73 
主題
11 
精華
0 
積分
100 
點名
0  
作業系統
Win 8 
軟體版本
2007 
閱讀權限
20 
性別
女 
註冊時間
2013-5-11 
最後登錄
2018-7-25 

論壇榮譽勳章論壇贊助勳章
19#
發表於 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大

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
20#
發表於 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
複製代碼

TOP

        靜思自在 : 謊言像一朵盛開的鮮花，外表美麗，生命短暫。
123
返回列表 上一主題