3d 凸包 ghx已传上

panhao1

3000ms
扫描算法是网上的 请高人指点
基本上没有用处
算法相当蛮力
弄出几乎可能出现的所有的面 然后逐面进行判定
19个点就存在16*16*16=4096个面 判定4096次 很恐怖的
{:3_63:}
以前2d hull的算法也很糟糕 请高手指点
这里贴上2d hull的代码
Private Sub RunScript(ByVal x As List(Of On3dPoint), ByRef A As Object)
    'your code goes here…
    Dim list As  New List (Of On3dPoint)
    Dim firstPt As New On3dPoint(x(0))
    Dim j As Integer = 0
    For i As Integer = 1 To x.count - 1
      If x(i).x < firstPt.x Then
        firstPt = x(i)
        j = i
      End If
    Next
    list.Add(firstpt)
    Dim firstPt1 As New On3dPoint(firstpt)
    'first is correct
    Dim listPt As New List (Of On3dPoint)(x)
    listPt.RemoveRange(j, 1)
    Dim sign As Integer = 0
    While sign = 0
      'print(jj)
      For ii As Integer=0 To listpt.Count - 1
        If ispt(firstPt, listpt(ii), listpt, ii) = True Then
          If listpt(ii) = firstpt1 Then
            sign = 1
            Exit For
          Else
            print(ispt(firstPt, listpt(ii), listpt, ii))
            Dim newlistpt As New List (Of On3dPoint)(x)
            newlistpt = removeitem(firstpt, newlistpt)
            print(newlistpt.count)
            firstPt = listpt(ii)
            list.Add(firstpt)
            newlistpt = removeitem(firstpt, newlistpt)
            print(newlistpt.count)
            listpt = newlistpt
            Exit For
          End If
        End If
      Next
    End While
    a = list







  End Sub
  '<Custom additional code>
  Function ispt(first, second, list, i)
    Dim list1 As New list(Of On3dpoint)
    list1 = list
    Dim second1 As New On3dpoint
    second1 = second
    Dim vector As New On3dVector
    vector = first - second
    Dim v As New On3dVector(0, 0, 1)
    vector.Rotate(1.5708, v)
    Dim third As New list(Of On3dPoint)(list1)
    third.removerange(i, 1)
    Dim sign As Double = 0
    '____________________________________________
    For j As Integer=0 To third.count - 1
      Dim forth As New On3dVector
      forth = first - third(j)
      Dim v1 As New On3dVector(vector)
      Dim v2 As New On3dVector(forth)
      v1.unitize()
      v2.unitize()
      Dim dot As Double
      dot = OnUtil.ON_DotProduct(v1, v2)
      If (dot > 1) Then dot = 1
      If (dot < -1) Then dot = -1
      dot = math.Acos(dot)
      If dot < 1.571 Then
        sign = 1
        Exit For
      End If
    Next
    '______________________________
    If sign = 0 Then
      ispt = True
    Else
      ispt = False
    End If
  End Function
  Function removeitem(item, list)
    Dim newlist As New list(Of On3dPoint)
    For i As Integer=0 To list.count - 1
      If  list(i) <> item Then
        newlist.add(list(i))
      End If
    Next
    removeitem = newlist
  End Function


效果视屏已传上

panhao1

最快的算法是通过求向量交角来判定边界 我用的是数点Function ispt(first, second, list, i)
慢了一个数量级 有没有哪位同学知道如何区分交角是顺时针还是逆时针

skywoolf

有点理解紫暗说的算法问题了，期待高手出现.

nice

囧，你不是做出了个，3D 的么，怎么不贴下，也许大家写不会，要改的话就容易多了，这样也容易多了吧

panhao1

4# nice

讨论算法的话并不需要代码吧
网上有C++的扫描算法 但是移植到gh里还是有些困难的
我的算法很简单 就是判定所有存在的面是否符合凸包的要求

计算几何上的逐个添加点的算法 不知有人看懂了没有
讨论算法用伪码就行了

这是3d hull的伪码
输入 L(3d 点）
for (i=0 ，i<L.length-2,i++){
for (j=i ，i<L.length-1,j++){
for (k=j ，i<L.length-,k++){
if（L（i),L（j),L（k)组成的面否符合hull的边界条件){
添加L（i),L（j),L（k)组成的面到集合M中
}

}
}
}


算法太囧 不好意思贴出来

renn

O'Rourke (1998) gives a robust two-dimensional implementation as well as an  three-dimensional implementation. Qhull works efficiently in 2 to 8 dimensions (Barber et al. 1996).

panhao1

7# gzblake
其他算发有退化的bug的 2级循环算法是很烂
一般都是通过 向量朝一个方向的转角的大小 找点
Function ispt(first, second, list, i)
是很笨的方法 但bug最少

你可以改成求出（已知的一条边和 （这条边的末端点与其它点的连线）的交角集合）中的最小值来找点

panhao1

9# gzblake
2d凸包不算退化情况的话 是这样的 思考怎样用一根线箍住扎在木板上的一些钉子就就明白了

skywoolf

{:3_51:}这个图表达的真清晰~

咸鱼空间

买来看看{:3_46:}

panhao1

修改了一个bug 把ghx文件传上来了
会C++的大歌帮忙指点下扫描法吧

abiao111

5# panhao1
思路很清晰哈
哦 两级嵌套循环…感觉貌似冗余度有点大………

Qrange

感觉是个好东西~

yl0110

真的很牛····

hadid

凸包是什么呢，我觉得这个还是真不错

dunksman

很棒啊!! 学习,学习!