Question

对此我有点陌生，但我试图创建一个具有相等间距的随机生成的3d坐标点，我尝试将其用于每个循环，但对如何使用却感到困惑。目的是生成球体围绕这一点，但某些领域相互重叠。提前致谢。下面的代码显示了我如何生成球体

    For i = 0 To noofsp - 1
        x = Rnd(1) * maxDist
        ws1.Cells(i + 5, 2) = x

        y = Rnd(1) * maxDist
        ws1.Cells(i + 5, 3) = y

        z = Rnd(1) * maxDist
        ws1.Cells(i + 5, 4) = z

        centers.Add({x, y, z})
    Next

Answer 1

您需要对照所有其他点检查新点，以确保新点与新球体和要检查的每个球体的半径之和相距更大的距离

您需要使用毕达哥拉斯定理检查距离，我从this site找到了下面的代码。该网站上的代码是用c＃编写的，但这是vb.net版本。

Public Function Distance3D(x1 As Integer, y1 As Integer, z1 As Integer, x2 As Integer, y2 As Integer, z2 As Integer) As Integer
    '     __________________________________
    'd = √ (x2-x1)^2 + (y2-y1)^2 + (z2-z1)^2
    '
    'Our end result
    Dim result As Integer = 0
    'Take x2-x1, then square it
    Dim part1 As Double = Math.Pow((x2 - x1), 2)
    'Take y2-y1, then sqaure it
    Dim part2 As Double = Math.Pow((y2 - y1), 2)
    'Take z2-z1, then square it
    Dim part3 As Double = Math.Pow((z2 - z1), 2)
    'Add both of the parts together
    Dim underRadical As Double = part1 + part2 + part3
    'Get the square root of the parts
    result = CInt(Math.Sqrt(underRadical))
    'Return our result
    Return result
End Function

要生成球体，您需要扩展代码以包括针对所有先前生成的点检查新点。该代码在下面并带有注释。

我假设定义了一个名为minDistance的变量，用于指定球体中心应相距多远。我还假设所有球体的大小相同。该数字应为球体半径的两倍

Private Sub GenerateSpheres()
    Randomize
    For i As Integer = 0 To noofsp - 1
        Dim distanceOK As Boolean = False
        Dim x, y, z As Integer
        'keep generating points until one is found that is
        'far enough away. When it is, add it to your data

        While distanceOK = False

            x = Rnd(1) * maxDist
            y = Rnd(1) * maxDist
            z = Rnd(1) * maxDist
            'If no other points have been generated yet, dont bother
            'checking your new point
            If centers.Count = 0 Then
                distanceOK = True
            Else
                'If other points exist, loop through the list and check distance
                For j As Integer = 0 To centers.Count - 1
                    'if the point is too close to any other, stop checking,
                    'exit the For Loop and the While Loop will generate a new
                    'coordinate for checking, and so on
                    Dim dist As Integer = Distance3D(centers(j)(0), centers(j)(1), centers(j)(2), x, y, z)
                    If dist <= minDistance Then
                        distanceOK = False
                        'exit the For loop and start the next iteration of the While Loop
                        Continue While
                    End If
                Next
                'If all previous points have been checked none are too close
                'flag distanceOK as true
                distanceOK = True
            End If
        End While
        'ws1.Cells(i + 5, 2) = x
        'ws1.Cells(i + 5, 3) = y
        'ws1.Cells(i + 5, 4) = z
        centers.Add({x, y, z})
    Next
End Sub

3d坐标系中两点之间的间距

1 个答案: