Clone with merge script

Paul

Could you please find a cure for all known diseases, oh and world peace would be nice.

Many thanks, what service

Paul

Paul_K mentioned (in the Amabilis chat room!) about the clone operation being difficult, having to merge all the groups after running, so I said I’d take a look… half an hour later…

It’s quite basic, but someone may find it useful.

(beware of line wrapping)

[pre class=’ip-ubbcode-code-pre’]Language = VBScript

‘*********************************************************************************
‘ Purpose: Clone and merge with the original object
‘*********************************************************************************

Option Explicit ‘require variable declarations

Sub Main (3DCApp)

Dim Scene
Dim ActiveObjectCount
Dim Direction
Dim Qty
Dim Shift
Dim NumericShift
Dim Reply

‘get the scene
Set Scene = 3DCApp.GetActiveScene

‘get the active object count
ActiveObjectCount = Scene.GetActiveObjectCount

‘only proceed if there is an active object
If ActiveObjectCount = 0 Then
MsgBox andquot;Please select an object.andquot;
Else
‘ this will assume anything other than X, Y or Z is actually X
Direction=Ucase(InputBox(andquot;Direction X, Y or Z ?andquot;,,andquot;Xandquot;))

‘ask the user how much to shift the object
Shift = InputBox(andquot;Shift?andquot;,,andquot;1.0andquot;)

‘ask the user number of clones
Qty = InputBox(andquot;Number of Clones ?andquot;,,andquot;1andquot;)

‘translate the entered string into a numeric value
On Error Resume Next
NumericShift = CSng(Shift)
Err.Clear
On Error Goto 0
CloneM Scene, NumericShift, Direction, Qty
End If
End Sub

Sub CloneM (Scene, Shift, Dir, Qty)

Dim Object
Dim PointCount
Dim PointIndex
Dim FaceCount
Dim FaceIndex
Dim Face
Dim NewFace
Dim FacePntCount
Dim FacePntIndex
Dim FacePnt
Dim PointX
Dim PointY
Dim PointZ
Dim i

‘get the active object (right now there can only be one)
Set Object = Scene.GetActiveObject(0)

‘get the number of points in the object
PointCount = Object.GetPointCount
FaceCount = Object.GetFaceCount

‘Run through the points shifting them
for i = 1 to Cint(Qty)
For PointIndex = 0 to PointCount – 1
‘get the point
Object.GetPoint PointIndex, PointX, PointY, PointZ

‘shift the point
Select Case Dir
Case andquot;Yandquot;
PointY = PointY + Shift*i
Case andquot;Zandquot;
PointZ = PointZ + Shift*i
Case Else
PointX = PointX + Shift*i
End select

‘set the new point
Object.AddPoint PointX, PointY, PointZ
Next
For FaceIndex = 0 to FaceCount – 1
‘get the face
Set Face = Object.GetFace(FaceIndex)
Set NewFace = Object.CreateFace
FacePntCount = Face.GetPointCount
for FacePntIndex = 0 to FacePntCount-1
PointIndex = Face.GetPoint(FacePntIndex)
NewFace.AddPointAndNormal i*PointCount+PointIndex,0
Next
Next
Next

‘finally write a Script operation layer to save the change
Object.GenerateNormals 3.1415926/3
Object.WriteScriptOperationLayer

End Sub
[/pre]