Tìm kiếm Blog này

Thứ Ba, 17 tháng 8, 2010

random points




Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic Studio>
'Script version Friday, October 02, 2009 12:22:08 AM

Call Main()
Sub Main()
    Dim i, j, arrObjects, strType, strMethod, intCount, dblRadius, dblDim(2), arrCircles(), arrPoints()
   
    intCount = Rhino.GetInteger("Total Number of Points",100,1)
    If IsNull(intCount) Then Exit Sub
   
    strType = Rhino.GetString("Select Geometry Type","Circle",Array("Circle","Sphere","Cube","Curve","Surface"))
    If IsNull(strType) Then Exit Sub
   
    If strType = "Circle" Then
        strType = Rhino.GetString("Select Circle Geometry","Object",Array("Object","ByOrigin"))
        If IsNull(strType) Then Exit Sub
        strMethod = Rhino.GetString("Select Circle Method","Dispersed",Array("Dispersed","Radial"))
        If IsNull(strMethod) Then Exit Sub
       
        If strType = "Object" Then
            arrObjects = Rhino.GetObjects("Select Circles",4,,True)
            If IsNull(arrObjects) Then Exit Sub
            j=0
           
            For i = 0 To UBound(arrObjects) Step 1
                If Rhino.IsCircle(arrObjects(i)) Then
                    ReDim Preserve arrCircles(j), arrPoints(j)
                    arrCircles(j) = arrObjects(i)
                    arrPoints(j) = Rhino.CircleCenterPoint(arrCircles(j))
                    j = j+1
                End If
            Next
            arrObjects = arrPoints
        Else
            arrObjects = Rhino.GetObjects("Select Origin Points",1,,True)
            If IsNull(arrObjects) Then Exit Sub
            dblRadius = Rhino.GetReal("Radius",1)
            If IsNull(dblRadius) Then Exit Sub
        End If
        Call Rhino.EnableRedraw(False)
        For i = 0 To UBound(arrObjects) Step 1
            If strType = "Object" Then
                dblRadius = Rhino.CircleRadius(arrCircles(i))
            Else
                arrObjects(i) = Rhino.PointCoordinates(arrObjects(i))
            End If
            If strMethod = "Radial" Then
                Call Rhino.AddPointCloud(randomPointCircleRadial(arrObjects(i), dblRadius, intCount))
            Else
                Call Rhino.AddPointCloud(randomPointCircle(arrObjects(i), dblRadius, intCount))
            End If
        Next
        Call Rhino.EnableRedraw(True)
        Exit Sub
       
    ElseIf strType = "Sphere" Then
        strMethod = Rhino.GetString("Select Sphere Method","Volume",Array("Volume","Radial","Shell"))
        If IsNull(strMethod) Then Exit Sub
        arrObjects = Rhino.GetObjects("Select Origin Points",1,,True)
        If IsNull(arrObjects) Then Exit Sub
        dblRadius = Rhino.GetReal("Radius",1)
        If IsNull(dblRadius) Then Exit Sub
        Call Rhino.EnableRedraw(False)
        For i = 0 To UBound(arrObjects) Step 1
            If strMethod = "Volume" Then
                Call Rhino.AddPointCloud(randomPointSphere(Rhino.PointCoordinates(arrObjects(i)), dblRadius, intCount))
            ElseIf strMethod = "Shell" Then
                Call Rhino.AddPointCloud(randomPointSphereShell(Rhino.PointCoordinates(arrObjects(i)), dblRadius, intCount))
            Else
                Call Rhino.AddPointCloud(randomPointSphereVol(Rhino.PointCoordinates(arrObjects(i)), dblRadius, intCount))
            End If
        Next       
        Call Rhino.EnableRedraw(True)
        Exit Sub
       
    ElseIf strType = "Cube" Then
        strMethod = Rhino.GetString("Select Cube Method","Volume",Array("Volume","Shell"))
        If IsNull(strMethod) Then Exit Sub
        arrObjects = Rhino.GetObjects("Select Origin Points",1,,True)
        If IsNull(arrObjects) Then Exit Sub
        dblDim(0) = Rhino.GetReal("Length",1)
        dblDim(1) = Rhino.GetReal("Width",1)
        dblDim(2) = Rhino.GetReal("Height",1)
        Call Rhino.EnableRedraw(False)
        For i = 0 To UBound(arrObjects) Step 1
            If strMethod = "Volume" Then
                Call Rhino.AddPointCloud(randomPointCubeVol(Rhino.PointCoordinates(arrObjects(i)), dblDim(0), dblDim(1), dblDim(2), intCount))
            Else
                Call Rhino.AddPointCloud(randomPointCube(Rhino.PointCoordinates(arrObjects(i)), dblDim(0), dblDim(1), dblDim(2), intCount))
            End If
        Next
        Call Rhino.EnableRedraw(True)
        Exit Sub
       
    ElseIf strType = "Curve" Then
        arrObjects = Rhino.GetObjects("Select Curves",4,,True)
        If IsNull(arrObjects) Then Exit Sub
        dblRadius = Rhino.GetReal("Maximum Deviation",1)
        If IsNull(dblRadius) Then Exit Sub
        Call Rhino.EnableRedraw(False)
        For i = 0 To UBound(arrObjects) Step 1
            Call reparameterize(arrObjects(i))
            Call Rhino.AddPointCloud(randomPtsCrv(arrObjects(i),dblRadius,intCount))
        Next
        Call Rhino.EnableRedraw(True)
        Exit Sub
       
    ElseIf strType = "Surface" Then
        arrObjects = Rhino.GetObjects("Select Surfaces",8,,True)
        If IsNull(arrObjects) Then Exit Sub
        dblRadius = Rhino.GetReal("Maximum Deviation",1)
        If IsNull(dblRadius) Then Exit Sub
        Call Rhino.EnableRedraw(False)
        For i = 0 To UBound(arrObjects) Step 1
            Call reparameterize(arrObjects(i))
            Call Rhino.AddPointCloud(randomPtsSrf(arrObjects(i),dblRadius,intCount))
        Next
        Call Rhino.EnableRedraw(True)
        Exit Sub
    End If
       
End Sub
Function randomPointCircleRadial(arrOrigin, dblRadius, intCount)
    randomPointCircleRadial = Null
    Dim i, dblRandom(1), arrOutput()
    ReDim arrOutput(intCount-1)
   
    For i = 0 To intCount-1 Step 1
        dblRandom(0) = random(0,2*PI)
        dblRandom(1) = random(0,dblRadius)
        arrOutput(i) = Array(arrOrigin(0)+dblRandom(1)*Sin(dblRandom(0)),arrOrigin(1)+dblRandom(1)*Cos(dblRandom(0)),arrOrigin(2))
    Next
    randomPointCircleRadial = arrOutput
End Function
Function randomPointCircle(arrOrigin, dblRadius, intCount)
    randomPointCircle = Null
    Dim i, arrOutput()
    ReDim arrOutput(intCount-1)
   
    For i = 0 To intCount-1 Step 1
        Do
            arrOutput(i) = Array(arrOrigin(0)+random(-dblRadius,dblRadius),arrOrigin(1)+random(-dblRadius,dblRadius),arrOrigin(2))
           
            If Rhino.Distance(arrOrigin,arrOutput(i)) < dblRadius Then Exit Do
        Loop
    Next
    randomPointCircle = arrOutput
End Function
Function randomPointSphereShell(arrOrigin, dblRadius, intCount)
    randomPointSphereShell = Null
    Dim i, dblRandom(1), arrOutput()
    ReDim arrOutput(intCount-1)
   
    For i = 0 To intCount-1 Step 1
        dblRandom(0) = random(0,2*PI)
        dblRandom(1) = random(0,PI)
        arrOutput(i) = Array(arrOrigin(0)+dblRadius*Sin(dblRandom(0))*Sin(dblRandom(1)),arrOrigin(1)+dblRadius*Cos(dblRandom(0))*Sin(dblRandom(1)),arrOrigin(2)+dblRadius*Cos(dblRandom(1)))
    Next
    randomPointSphereShell = arrOutput
End Function
Function randomPointSphere(arrOrigin, dblRadius, intCount)
    randomPointSphere = Null
    Dim i, arrOutput()
    ReDim arrOutput(intCount-1)
   
    For i = 0 To intCount-1 Step 1
        Do
            arrOutput(i) = Array(arrOrigin(0)+random(-dblRadius,dblRadius),arrOrigin(1)+random(-dblRadius,dblRadius),arrOrigin(2)+random(-dblRadius,dblRadius))
            If Rhino.Distance(arrOrigin,arrOutput(i)) < dblRadius Then Exit Do
        Loop
    Next
    randomPointSphere = arrOutput
End Function
Function randomPointSphereVol(arrOrigin, dblRadius, intCount)
    randomPointSphereVol = Null
    Dim i, dblRandom(2), arrOutput()
    ReDim arrOutput(intCount-1)
   
    For i = 0 To intCount-1 Step 1
        dblRandom(0) = random(0,2*PI)
        dblRandom(1) = random(0,PI)
        dblRandom(2) = random(0,dblRadius)
        arrOutput(i) = Array(arrOrigin(0)+dblRandom(2)*Sin(dblRandom(0))*Sin(dblRandom(1)),arrOrigin(1)+dblRandom(2)*Cos(dblRandom(0))*Sin(dblRandom(1)),arrOrigin(2)+dblRandom(2)*Cos(dblRandom(1)))
    Next
    randomPointSphereVol = arrOutput
End Function
Function randomPointCube(arrOrigin, dblLength, dblWidth, dblHeight, intCount)
    randomPointCube = Null
    Dim i, arrOutput()
    ReDim arrOutput(intCount-1)
   
    For i = 0 To intCount-1 Step 1
        arrOutput(i) = Array(arrOrigin(0)+random(0,dblLength),arrOrigin(1)+random(0,dblLength),arrOrigin(2)+random(0,dblHeight))
    Next
    randomPointCube = arrOutput
End Function
Function randomPointCubeVol(arrOrigin, dblLength, dblWidth, dblHeight, intCount)
    randomPointCubeVol = Null
    Dim i, arrOutput()
    ReDim arrOutput(intCount-1)
   
    For i = 0 To intCount-1 Step 1
        arrOutput(i) = Array(arrOrigin(0)+random(0,dblLength),arrOrigin(1)+random(0,dblLength),arrOrigin(2)+random(0,dblHeight))
    Next
    randomPointCubeVol = arrOutput
End Function
Function randomPtsCrv(strCurve,dblDist,intCount)
    randomPtsCrv = Null
    Dim i, tDom, dblRandom, arrOutput()
    ReDim arrOutput(intCount-1)
    tDom = Rhino.CurveDomain(strCurve)
   
    For i = 0 To intCount-1 Step 1
        dblRandom = random(tDom(0),tDom(1)-tDom(0))
        arrOutput(i) = Rhino.PointAdd(Rhino.EvaluateCurve(strCurve,dblRandom),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.CurvePerpFrame(strCurve,dblRandom)(1)),random(-dblDist,dblDist)))
    Next

    randomPtsCrv = arrOutput
End Function
Function randomPtsSrf(strSurface,dblDist,intCount)
    randomPtsSrf = Null
    Dim i, uDom, vDom, arrOutput()
    ReDim arrOutput(intCount-1)
    uDom = Rhino.SurfaceDomain(strSurface,0)
    vDom = Rhino.SurfaceDomain(strSurface,1)
   
    For i = 0 To intCount-1 Step 1
        arrOutput(i) = Rhino.PointAdd(Rhino.EvaluateSurface(strSurface,Array(random(uDom(0),uDom(1)),random(vDom(0),vDom(1)))),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(strSurface,Array(random(uDom(0),uDom(1)),random(vDom(0),vDom(1))))),random(-dblDist,dblDist)))
    Next

    randomPtsSrf = arrOutput
End Function
Function random(min,max)
    random = Null
    Dim dblValue: dblValue = min+(max-min)*Rnd()
    random = dblValue
End Function
Function reparameterize(strObjectID)
    If Rhino.IsCurve(strObjectID) = True Then
        Call Rhino.SelectObject(strObjectID)
        Call Rhino.Command("reparameterize 0 1",False)
        Call Rhino.UnselectAllObjects()
    End If
    If Rhino.IsSurface(strObjectID) = True Then
        Call Rhino.SelectObject(strObjectID)
        Call Rhino.Command("reparameterize 0 1 0 1",False)
        Call Rhino.UnselectAllObjects()
    End If
End Function

Không có nhận xét nào:

Đăng nhận xét

Người theo dõi