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


效果视屏已传上

左手◆23年

不错，感谢楼主分享！

ha123321

感谢楼主啊

ha123321

很好的教程，多谢楼主分享！~~

ha123321

感谢楼主啊

9j6ikr3u

网络举报、社会事件发帖，举报爆料曝光℡182{8611}9596,UV
举报专业发帖，检举爆料曝光，还社会一个公道。152+1122_238  182{8611}9596,UV 点击百度快照
假设看不到信息，请点击右下角“百度百度快照”。本团队是网络专业举报发帖，由8人组成，日手工发帖量6000，有24万论坛的数据。可以让你需要传播的信息2天之内发送到各大搜索引擎（如百度，谷歌等）。有无数热心的网友关注转载。
本团队自2008年创办，已有3年的历史和经验，为一些正规渠道无法上报，无法让公众知晓的事件发帖曝光。 为整个社会更加公平公正贡献一份力量。
152+1122_238  182{8611}9596,UV

s.k.

与神在交流，嘿嘿

V.Y

这个技术贴，，，都是大侠- -

cloudone

真的很不错哟~~

haiou8

不知道说啥

王建芹

下载下来 学习学习

foxaaa

这个完全不懂啊
楼主

红叶小子

怎么总是看不到呢

于房巴

1~3折售ONLY_H&M_杰克琼斯_ZARA等知名品牌服装（专柜新品 与市场同步 假一罚十） :13132208878

天津地区送货上门货到付款，发现质量问题无条件退全款，批发零售皆可。

所有商品均为原单，数量有限清版即止，欲购从速。

13132208878  QQ 78130933

rfnkwj

真的很蠻力阿....

元未觉醒1984

望楼主降价啊

元未觉醒1984

这么贵？？

hfly31

强悍啊！！！！11

刘鹏涛

感谢楼主分享 分享了

3582076094

支持3d……