返回列表 上一主題 發帖

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

回復 12# stillfish00
stillfish00大 超厲害,真是天才耶~
我好好的研究一下,真的謝謝!   相信以後你有需要,別人也一定會幫你的^^~

TOP

回復 12# stillfish00


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

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

TOP

回復 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

回復 6# stillfish00

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

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

也謝謝ML089的參與^^~

TOP

回復 6# stillfish00

不好意思,借該版資料

stillfish00大:
可否請你再幫忙寫 A、B、C等區域面積的自訂函數,感恩。
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復 5# ui123

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

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

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

我再來研究可否用公式決解,但會比VBA看起來更複雜。
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復 6# stillfish00


    鼓勵一下,C語言改為VBA,剛好可以參考,謝謝
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復 3# stillfish00


  stillfish00大提供的資料很完整,謝謝你提供那麼完整的網頁資訊。
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

本帖最後由 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)"

TOP

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

TOP

        靜思自在 : 稻穗結得越飽滿,越會往下垂,一個人越有成就,就要越有謙沖的胸襟。
返回列表 上一主題