PowerCopy Automation

Fabric pattern completed via powerCopy Automation. Method is the following three steps →


STEP1. BeginInstanceFactory: to initialize the InstanceFactory with the reference and the document where it is stored. This step must be called once at the beginning whatever the number of instantiations are done.

STEP2. It is composed of five methods that must be called in the order. This set of five methods can be called in a loop in order to make several instantiations.

a. The method BeginInstantiate: to initialize all data of the reference.
b. The method PutInputData: to set a value to any input.
c. The method GetParameter: to retrieve published parameter.
d. The method Instantiate: to recreate the reference.
e. The method EndInstantiate: to indicate the instantiation is done.

STEP3. EndInstantiateFactory: to end instantiation and cleaning the InstanceFactory. When doing several instantiations in a loop, this step must be called just once at the end of all instantiations.

boundary cone

Option Explicit
'Author: YukiukiH
'Date: 10/08/2008
'compatibility: Rhino4
''boundary CONE
'----------------------------------------------------------------------------------------------
Dim strTrgPt, arrTrgPt
strTrgPt = Rhino.GetObject ("select a target point", 1)
Dim strALLRefPts
strALLRefPts = Rhino.GetObjects ("select reference points", 1)
Dim strPtDir, arrPtDir, arrDirVector
strPtDir = Rhino.GetObject ("select a point for direction", 1)
Dim strRefPts
strRefPts = boundaryCone (strTrgPt, strALLRefPts, strPtDir, 400, 30)

'color
Dim intR, intG, intB
Dim i
For i = 0 To UBound(strRefPts)
intR =255
intG =25+i*Rnd()*2
intB =0
Call Rhino.ObjectColor (strRefPts(i), RGB(intR, intG, intB))
Next
Call Rhino.print("execution completed")


'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
Function boundaryCone (strTrgPt, strALLRefPts, strPtDir, dblBoundCos, dblBoundAngle)
Dim arrResult

'coordinate extraction
'----------------------------------------------------------------------------------------------
Dim arrTrgPt
arrTrgPt = Rhino.PointCoordinates (strTrgPt)
Dim arrALLRefPts()
Dim i
For i = 0 To UBound(strALLRefPts)
ReDim Preserve arrALLRefPts(i)
arrALLRefPts(i) = Rhino.PointCoordinates (strALLRefPts(i))
Next
Dim arrPtDir
arrPtDir = Rhino.PointCoordinates (strPtDir)

'set boundary
'---------------------------------------
Dim arrLine1(1), arrLine2(1)
Dim dblAngles, dblVectorLength, dblDist
Dim arrREFPts(), strRefPts()
Dim n, m
n = 0
For m = 0 To UBound(arrALLRefPts)
arrLine1(0) = arrPtDir
arrLine1(1) = arrTrgPt
arrLine2(0) = arrALLRefPts(m)
arrLine2(1) = arrTrgPt
dblAngles = Rhino.Angle2 (arrLine1, arrLine2)

If dblAngles(0) < dblBoundAngle Then
dblVectorLength = Rhino.Distance (arrALLRefPts(m), arrTrgPt)
dblDist = dblVectorLength *Cos(dblAngles(0)*2*dblPi/360) 'cone
If dblDist < dblBoundCos Then
Call Rhino.Print ("through point: " & CStr(n+1))
ReDim Preserve arrRefPts(n)
arrRefPts(n) = arrALLRefPts(m)
ReDim Preserve strRefPts(n)
strRefPts(n) = strALLRefPts(m)
n = n+1
End If
End If

Next
'---------------------------------------
arrResult = strRefPts
boundaryCone = arrResult
End Function
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------

boundary partial sphere

Option Explicit
'Author: YukiukiH
'Date: 10/08/2008
'compatibility: Rhino4
''boundary PARTIAL SPHERE
'----------------------------------------------------------------------------------------------
Dim strTrgPt, arrTrgPt
strTrgPt = Rhino.GetObject ("select a target point", 1)
Dim strALLRefPts
strALLRefPts = Rhino.GetObjects ("select reference points", 1)
Dim strPtDir, arrPtDir, arrDirVector
strPtDir = Rhino.GetObject ("select a point for direction", 1)
Dim strRefPts
strRefPts = boundaryPartialSphere (strTrgPt, strALLRefPts, strPtDir, 450, 30)

'color
Dim intR, intG, intB
Dim i
For i = 0 To UBound(strRefPts)
intR =255
intG =25+i*Rnd()*2
intB =0
Call Rhino.ObjectColor (strRefPts(i), RGB(intR, intG, intB))
Next
Call Rhino.print("execution completed")


'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
Function boundaryPartialSphere (strTrgPt, strALLRefPts, strPtDir, dblBoundR, dblBoundAngle)
Dim arrResult

'coordinate extraction
'---------------------------------------
Dim arrTrgPt
arrTrgPt = Rhino.PointCoordinates (strTrgPt)
Dim arrALLRefPts()
Dim i
For i = 0 To UBound(strALLRefPts)
ReDim Preserve arrALLRefPts(i)
arrALLRefPts(i) = Rhino.PointCoordinates (strALLRefPts(i))
Next
Dim arrPtDir
arrPtDir = Rhino.PointCoordinates (strPtDir)

'set boundary
'---------------------------------------
Dim dblDist, dblAngles, arrDir
Dim arrLine1(1), arrLine2(1)
Dim arrREFPts(), strRefPts()
Dim n, m
n = 0
For m = 0 To UBound(arrALLRefPts)
dblDist = Rhino.Distance (arrTrgPt, arrALLRefPts(m))

If dblDist < dblBoundR Then
arrLine1(0) = arrPtDir
arrLine1(1) = arrTrgPt
arrLine2(0) = arrALLRefPts(m)
arrLine2(1) = arrTrgPt
dblAngles = Rhino.Angle2 (arrLine1, arrLine2)
If dblAngles(0) < dblBoundAngle Then
Call Rhino.Print ("through point: " & CStr(n+1))
ReDim Preserve arrRefPts(n)
arrRefPts(n) = arrALLRefPts(m)
ReDim Preserve strRefPts(n)
strRefPts(n) = strALLRefPts(m)
n = n+1
End If
End If

Next
'---------------------------------------
arrResult = strRefPts
boundaryPartialSphere = arrResult
End Function
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------

boundary sphere

Option Explicit
'Author: YukiukiH
'Date: 10/08/2008
'compatibility: Rhino4
''boundary SPHERE
'----------------------------------------------------------------------------------------------
Dim strTrgPt
strTrgPt = Rhino.GetObject ("select a target point", 1)
Dim strALLRefPts
strALLRefPts = Rhino.GetObjects ("select reference points", 1)
Dim strRefPts
strRefPts = boundarySphere (strTrgPt, strALLRefPts, 250)

'color
Dim intR, intG, intB
Dim i
For i = 0 To UBound(strRefPts)
intR =255
intG =25+i*Rnd()*2
intB =0
Call Rhino.ObjectColor (strRefPts(i), RGB(intR, intG, intB))
Next
Call Rhino.print("execution completed")


'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
Function boundarySphere (strTrgPt, strALLRefPts, dblBoundR)
Dim arrResult


'coordinate extraction
'---------------------------------------
Dim arrTrgPt
arrTrgPt = Rhino.PointCoordinates (strTrgPt)
Dim arrALLRefPts()
Dim i
For i = 0 To UBound(strALLRefPts)
ReDim Preserve arrALLRefPts(i)
arrALLRefPts(i) = Rhino.PointCoordinates (strALLRefPts(i))
Next


'set boundary
'---------------------------------------
Dim dblDist, arrREFPts(), strRefPts()
Dim n, m
n = 0
For m = 0 To UBound(arrALLRefPts)
dblDist = Rhino.Distance (arrTrgPt, arrALLRefPts(m))

If dblDist < dblBoundR Then
Call Rhino.Print ("through point: " & CStr(n+1))
ReDim Preserve arrRefPts(n)
arrRefPts(n) = arrALLRefPts(m)
ReDim Preserve strRefPts(n)
strRefPts(n) = strALLRefPts(m)
n = n+1
End If

Next
'---------------------------------------
arrResult = strRefPts
boundarySphere = arrResult
End Function
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------

boundary cylinder

Option Explicit
'Author: YukiukiH
'Date: 10/08/2008
'compatibility: Rhino4
''boundary CYLINDER
'----------------------------------------------------------------------------------------------
Dim strTrgPt
strTrgPt = Rhino.GetObject ("select a target point", 1)
Dim strALLRefPts
strALLRefPts = Rhino.GetObjects ("select reference points", 1)
Dim strRefPts
strRefPts = boundaryCylinder (strTrgPt, strALLRefPts, 200, 400)

'color
Dim intR, intG, intB
Dim i
For i = 0 To UBound(strRefPts)
intR =255
intG =25+i*Rnd()*2
intB =0
Call Rhino.ObjectColor (strRefPts(i), RGB(intR, intG, intB))
Next
Call Rhino.print("execution completed")


'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
Function boundaryCylinder (strTrgPt, strALLRefPts, dblBoundR, dblBoundZ)
Dim arrResult

'coordinate extraction
'---------------------------------------
Dim arrTrgPt
arrTrgPt = Rhino.PointCoordinates (strTrgPt)
Dim arrALLRefPts()
Dim i
For i = 0 To UBound(strALLRefPts)
ReDim Preserve arrALLRefPts(i)
arrALLRefPts(i) = Rhino.PointCoordinates (strALLRefPts(i))
Next

'set boundary
'---------------------------------------
Dim arrFlatPt, arrFlatRefPt, dblDist, dblmaxZ, dblminZ
Dim arrREFPts(), strRefPts()
dblmaxZ = arrTrgPt(2) + dblBoundZ
dblminZ = arrTrgPt(2)

Dim n, m
n = 0
For m = 0 To UBound(arrALLRefPts)
arrFlatPt = Array(arrTrgPt(0), arrTrgPt(1), 0)
arrFlatRefPt = Array(arrALLRefPts(m)(0),arrALLRefPts(m)(1), 0)
dblDist = Rhino.Distance (arrFlatPt, arrFlatRefPt)
If dblDist < dblBoundR Then
If dblmaxZ>arrALLRefPts(m)(2) And arrALLRefPts(m)(2)>dblminZ Then

Call Rhino.Print ("through point: " & CStr(n+1))
ReDim Preserve arrRefPts(n)
arrRefPts(n) = arrALLRefPts(m)
ReDim Preserve strRefPts(n)
strRefPts(n) = strALLRefPts(m)
n = n+1

End If
End If
Next
'---------------------------------------
arrResult = strRefPts
boundaryCylinder = arrResult
End Function
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------

bounday cube

Option Explicit
'Author: YukiukiH
'Date: 10/08/2008
'compatibility: Rhino4
''boundary CUBE
'----------------------------------------------------------------------------------------------
Dim strTrgPt
strTrgPt = Rhino.GetObject ("select a target point", 1)
Dim strALLRefPts
strALLRefPts = Rhino.GetObjects ("select reference points", 1)
Dim strRefPts
strRefPts = boundaryCube (strTrgPt, strALLRefPts, 300, 300, 400)

'color
Dim intR, intG, intB
Dim i
For i = 0 To UBound(strRefPts)
intR =255
intG =25+i*Rnd()*2
intB =0
Call Rhino.ObjectColor (strRefPts(i), RGB(intR, intG, intB))
Next
Call Rhino.print("execution completed")


'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
Function boundaryCube (strTrgPt, strALLRefPts, dblBoundX, dblBoundY, dblBoundZ)
Dim arrResult

'coordinate extraction
'---------------------------------------
Dim arrTrgPt
arrTrgPt = Rhino.PointCoordinates (strTrgPt)
Dim arrALLRefPts()
Dim i
For i = 0 To UBound(strALLRefPts)
ReDim Preserve arrALLRefPts(i)
arrALLRefPts(i) = Rhino.PointCoordinates (strALLRefPts(i))
Next

'set boundary
'---------------------------------------
Dim dblmaxX, dblminX, dblmaxY, dblminY, dblmaxZ, dblminZ
Dim arrREFPts(), strRefPts()
dblmaxX = arrTrgPt(0) +(dblBoundX/2)
dblminX = arrTrgPt(0) -(dblBoundX/2)
dblmaxY = arrTrgPt(1) +(dblBoundY/2)
dblminY = arrTrgPt(1) -(dblBoundY/2)
dblmaxZ = arrTrgPt(2) +(dblBoundZ/2)
dblminZ = arrTrgPt(2) -(dblBoundZ/2)

Dim n, m
n = 0
For m = 0 To UBound(arrALLRefPts)
If dblmaxX>arrALLRefPts(m)(0) And arrALLRefPts(m)(0)>dblminX Then
If dblmaxY>arrALLRefPts(m)(1) And arrALLRefPts(m)(1)>dblminY Then
If dblmaxZ>arrALLRefPts(m)(2) And arrALLRefPts(m)(2)>dblminZ Then

Call Rhino.Print ("through point: " & CStr(n+1))
ReDim Preserve arrRefPts(n)
arrRefPts(n) = arrALLRefPts(m)
ReDim Preserve strRefPts(n)
strRefPts(n) = strALLRefPts(m)
n = n+1

End If
End If
End If
Next
'---------------------------------------
arrResult = strRefPts
boundaryCube = arrResult
End Function
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------