Language = VBScript

'*********************************************************************************
' Purpose: Extrude any face along a curve     
'Script by George Jenner November 2002
'This is a totally raw and uncontrolled version of this script.  Use at your own risk.  Save everything
'before you run it.

'*********************************************************************************

    Option Explicit          'require variable declarations

    Public Material
    Public Scene
    Const     Pi= 3.14159265358979
    Const     e=2.718281828
Sub Main (CanvasApp)


    Dim ActiveFaceCount
    Dim Reply
  
    Dim Centre(2)
    Dim NewCentre(2)
    Dim Axis(2)
    Dim NewAxis(2)
    Dim OldAxis(2)
    Dim NewAxisTemp(2)
    Dim AxisTemp(2)
    Dim FirstPoint(2)
    Dim PointCoord(2)
    Dim FirstPointVec(2)
    Dim FirstPAxis(2)

    Dim FacePoints      'the number of points in the face to be extruded
    Dim FaceObject      'the object with the face to be extruded
    Dim SceneRootGroup
    Dim FaceGroup

'for analysis of face
    Dim SecondX
    Dim SecondY
    Dim SecondZ
    Dim SecondSide
    Dim ThirdSide    

    Dim Group           'for the created object
    Dim Object          'the object being created
    Dim Face            'the current face being worked on
    Dim ObjectPointNumber


   
'for extrusion
    Dim Counter
    Dim Along
    Dim Around
    Dim NumSegments  'number of times to extrude the face
    Dim Theta
    Dim ThetaY
    Dim ThetaZ
    Dim n0
    Dim n1
    Dim n2
    Dim X
    Dim Y
    Dim Z

    Dim i  'a counter



'******output for debug*******
'    Dim fso, 'myfile
'    Set fso = CreateObject("Scripting.FileSystemObject")
'    Set 'myfile = fso.CreateTextFile("c:\Program Files\3D Canvas\Scripts\aaavbtestfile.txt", True)
    'myfile.WriteLine("Debug for extruder")
'**************
    ' get the scene
    Set Scene = CanvasApp.GetActiveScene

    ' get the active face count
    ActiveFaceCount = Scene.GetActiveFaceCount

    ' only proceed if there is one active face
    If ActiveFaceCount <> 1 Then
        MsgBox "Please select one face." & chr(13) & "Faces selected: " & ActiveFaceCount
    Else
'*********object administration***************

    'Create a new object for the extruded segments.
    'first get the root Group
    Set SceneRootGroup = Scene.GetRootGroup
    Set FaceGroup=Scene.GetActiveGroup(0)
    
    Set FaceObject=Scene.GetActiveObject(0)
   'find the face to be extruded
    Set Face = Scene.GetActiveFace(0)
   'create a Group for the object (extruded face)
    Set Group = Scene.CreateGroup
    

   'add it to the FaceGroup to make coordinate stuff easier
    FaceGroup.AddChild Group
    'put the group in the same place as its parent FaceGroup
    Group.SetPosition FaceGroup,0,0,0,0
   'give the Group a name - note that we can't do this
   'until the Group is added to the scene
    Group.SetName "Extruded Face Group"

   'create an object
    Set Object = Scene.CreateObject()  
'**********start analysis of face to be extruded*********
   'now analyse the points
        
    FacePoints=Face.GetPointCount
    'Find the centre of the face
    Centre(0)=0
    Centre(1)=0
    Centre(2)=0
'myfile.Writeline("FacePoints"& FacePoints)
    For Counter = 0 to FacePoints-1
          ObjectPointNumber=Face.GetPoint(Counter)  'returns a pointer to the point number in object
          FaceObject.GetPoint ObjectPointNumber,POINTCOORD(0),POINTCOORD(1),POINTCOORD(2)
'myfile.Writeline("Coords" & POINTCOORD(0)&POINTCOORD(1)&POINTCOORD(2))
          Centre(0)=Centre(0) +POINTCOORD(0)
          Centre(1)=Centre(1) +POINTCOORD(1)
          Centre(2)=Centre(2) +POINTCOORD(2)
    Next  'Counter
    Centre(0)=Centre(0)/FacePoints
    Centre(1)=Centre(1)/FacePoints
    Centre(2)=Centre(2)/FacePoints
'myfile.Writeline("Fae Centre"&Centre(0)&" "&Centre(1)&" "&Centre(2))
  

   'make an array to hold the face parameters 
    Dim Radii()    'just need the  
    Dim Angles ()
    redim Radii(FacePoints)
    redim Angles (FacePoints-1)
   'now we're goint around the face getting the three sides of triangles that make it up
    Angles(0)=0  'the first point is always 0
    For Counter = 0 to FacePoints-1
          ObjectPointNumber=Face.GetPoint(Counter)  'returns a pointer to the point number in object
          FaceObject.GetPoint ObjectPointNumber,Firstpoint(0),Firstpoint(1),Firstpoint(2)
          ObjectPointNumber=Face.GetPoint(Counter+1)  'returns a pointer to the point number in object
          FaceObject.GetPoint ObjectPointNumber,SecondX,SecondY,SecondZ
          'the Third point in the triangles is always the Centre
          'The first Radius in the face is the distance from Centre to FirstPoint      
          Radii(Counter)=sqr((Centre(0)-Firstpoint(0))^2+(Centre(1)-Firstpoint(1))^2+(Centre(2)-Firstpoint(2))^2)
'myfile.Writeline("finding radius"& radii(counter))
          'We need to know three sides of the triangle to get the angle
          SecondSide=sqr((Centre(0)-SecondX)^2+(Centre(1)-SecondY)^2+(Centre(2)-SecondZ)^2)
          ThirdSide=sqr((Firstpoint(0)-SecondX)^2+(Firstpoint(1)-SecondY)^2+(Firstpoint(2)-SecondZ)^2)
          Angles(Counter)=LawOfCosines (Radii(Counter),SecondSide,ThirdSide)
          'the angle to be used will be the total as we go around the shape
          if Counter>0 then Angles(Counter)=Angles(Counter-1)+Angles(Counter)  else Angles(Counter)=0
'myfile.Writeline("finding angle"& Angles(Counter))
    Next  'Counter
'myfile.Writeline("Out of angle finding loop") 

    'The first axis is the normal to the face

    Face.GetFaceNormal Axis(0),Axis(1),Axis(2)
'******start creating the new object

   'Start adding things to the object
    Object.AddNormal 0,0,-1  
    CreateMaterial
   
   'First thing is to copy the original coordes as the face to be extruded 
    For Counter=0 to FacePoints-1
         ObjectPointNumber=Face.GetPoint(Counter)
         FaceObject.GetPoint ObjectPointNumber,POINTCOORD(0),POINTCOORD(1),POINTCOORD(2)  
         Object.AddPoint POINTCOORD(0),POINTCOORD(1),POINTCOORD(2)
    Next 'Counter    
    
    
    
   'To cap the new object you would have to create new faces here.  Not going to



'************************************************************************************************
'CHANGE THIS NUMBER FOR THE LENGTH OF YOUR EXTRUSION

 
    NumSegments=40                                  

'*************************************************************************************************
    
    For Along = 1 to NumSegments     

       'We also need to know the relationship of Centre to Point 0... or do we?
         Object.GetPoint (Along-1)*Facepoints,POINTCOORD(0),POINTCOORD(1),POINTCOORD(2)
         For i=0 to 2
            FirstPointVec(i)=Centre(i)-POINTCOORD(i)    'D stands for Delta here  - names not chosen alpahbetically...
'myfile.WriteLine("FirstPointVec "& i & "  " & FirstPointVec(i))
         Next
  
        'First thing to do is find the centre of the next segment according to chosen function    
        
        
'************************************************************************************************
'HERE IS WHERE YOU CHANGE THE FUNCTION TO BE EXTRUDED.  IT MUST CALL A VALID FUNCTION BASED ON THE ONE CALLED
'FINDNEWCENTRE                                                              
'Centre is a vector holding the coordinates of the current centre of the face being extruded
'These coordinates are passed to a function
'NewCentre is a vector holding the coordinates of the new centre of the face
        
        ' FindNewCentre  NewCentre,Centre  
          CorkScrew      NewCentre,Centre
         
'************************************************************************************************
'************************************************************************************************           
'myfile.Writeline("Centre"& Centre(0)&Centre(1)&Centre(2)) 
'myfile.Writeline("NewCentre"& NewCentre(0)&NewCentre(1)&NewCentre(2))
         'Now the axis for rotating around the centre
    
    for i=0 to 2
         NewAxis(i)=Newcentre(i)-Centre(i)
'myfile.Writeline("NewAxis"& i & "  " & NewAxis(i))

    next
         'first move everything to do rotations around 0,0,0

         'The first point hasn'tbeen set for the new face?????
'myfile.WriteLine("Set first point for face")
         for i=0 to 2
             Firstpoint(i)=NewCentre(i)-FirstPointVec(i)
'myfile.WriteLine("FirstPoint "& i & "  " & FirstPoint(i))
         next 
         'now move it all to 000
'myfile.WriteLine("Move it to centre")
         for i=0 to 2
             Firstpoint(i)=FirstPoint(i)-NewCentre(i)
'myfile.WriteLine("FirstPoint "& i & "  " & FirstPoint(i))
         next 
            
        
         'The first point has to be located for rotating      
         'To get the new location of first point we have to first make an axis for rotating it
         'The axis will be located by rotating the point itself around the new direction axis
''myfile.WriteLine("First rotation for axis")  
'Let's try and do this with two rotations.
'First around the Z axis
        
         NewAxisTemp(0)=NewAxis(0)
         NewAxisTemp(1)=NewAxis(1)
         NewAxisTemp(2)=0                 'set Z to 0 for normals and products in 2D


         AxisTemp(0)=Axis(0)
         AxisTemp(1)=Axis(1)
         AxisTemp(2)=0              'set Z to 0 for normals and products in 2D

         NormaliseVec NewAxisTemp
         NormaliseVec NewAxis
         ThetaZ = ArcCos(DotProduct(NewAxisTemp, AxisTemp))    
'myfile.WriteLine("DotProduct of New and Old axes is for Z rotation "  & ThetaZ)
         Cross NewAxisTemp,AxisTemp,n0,n1,n2 
'myfile.WriteLine("n1 is  " & n1)
         If n1<0 then ThetaZ=ThetaZ else ThetaZ=-1*ThetaZ 
       

'Second around the Y axis
         NewAxisTemp(0)=NewAxis(0)
         NewAxisTemp(1)=0
         NewAxisTemp(2)=NewAxis(2)                 'set Y to 0 for normals and products in 2D

         AxisTemp(0)=Axis(0)
         AxisTemp(1)=0
         AxisTemp(2)=Axis(2)              'set Y to 0 for normals and products in 2D

         NormaliseVec NewAxisTemp
         NormaliseVec NewAxis
         ThetaY = ArcCos(DotProduct(NewAxisTemp, AxisTemp))    
'myfile.WriteLine("DotProduct of New and Old axes is for Y rotation "  & ThetaY)
         Cross NewAxisTemp,AxisTemp,n0,n1,n2 
'myfile.WriteLine("n1 is  " & n1)
         If n1<0 then ThetaY=ThetaY else ThetaY=-1*ThetaY

'now do the rotations around Z and Y axes
         CanvasApp.rotatepoint FirstPoint(0),FirstPoint(1),FirstPoint(2),_
              0,0,1,ThetaZ,FirstPAxis(0),FirstPAxis(1),FirstPAxis(2)

         CanvasApp.rotatepoint FirstPoint(0),FirstPoint(1),FirstPoint(2),_
              0,1,0,ThetaY,FirstPAxis(0),FirstPAxis(1),FirstPAxis(2)


'         CanvasApp.rotatepoint FirstPoint(0),FirstPoint(1),FirstPoint(2),_
'              NewAxis(0),NewAxis(1),NewAxis(2),0,FirstPAxis(0),FirstPAxis(1),FirstPAxis(2)
         'To get the rotation of the first axis we need the dot product of new axis and old axis
''myfile.WriteLine("Normalise NewAxis  - from xyz" & NewAxis(0) & NewAxis(1) & NewAxis(2))
'         NormaliseVec NewAxis
''myfile.WriteLine("Normalise NewAxis  - to xyz" & NewAxis(0)& NewAxis(1) & NewAxis(2))'

'         ThetaY=ArcCos(DotProduct(NewAxis, Axis)) 
''myfile.WriteLine("DotProduct of New and Old axes is "  & ThetaY)
''myfile.WriteLine("CrossProduct of New and Old axes")  
'         Cross NewAxis,OldAxis,n0,n1,n2 
''myfile.WriteLine("n1 is  " & n1)
         If n1<0 then ThetaY=ThetaY else ThetaY=-1*ThetaY 
'         CanvasApp.rotatepoint FirstPoint(0),FirstPoint(1),FirstPoint(2),_
'              FirstPAxis(0),FirstPAxis(1),FirstPAxis(2),ThetaY,FirstPoint(0),FirstPoint(1),FirstPoint(2)    
'FIRSTPOINT STILL HAS TO BE ROTATED AROUND 2 AXES......  FOR NOW SEE IF WE CAN DEBUG THE BLOODY REST

         'Now rotate it around each axis

         For Around = 0 to FacePoints-1
         
            'rotate a point around the Axis
            'Add Newcentre(0),Yand Z to the result
            ' add the point to the object  
              
            CanvasApp.rotatepoint FirstPoint(0),FirstPoint(1),FirstPoint(2),_
              NewAxis(0),NewAxis(1),NewAxis(2),Angles(Around),X,Y,Z
            X=X+NewCentre(0)
            Y=Y+NewCentre(1)
            Z=Z+NewCentre(2) 
            Object.AddPoint X,Y,Z
'myfile.Writeline(" Segment " & Along & "Point " & Around &" coords " & X & Y & Z)

         Next 'Around 
         
'         For Around = 0 to FacePoints-1
'            'make a face using points from here and previous face
'            'add it to object  
'              Set Face = Object.CreateFace
'              Face.AddPointAndNormal (Along-1)*FacePoints+Around,0    
'              Face.AddPointAndNormal Along*FacePoints+Around,0 
'              'need to trap the last face to use the points of the first face?
'              if Around=(FacePoints-1) then
'                Face.AddPointAndNormal Along*FacePoints,0
'                Face.AddPointAndNormal (Along-1)*FacePoints,0 
'              else  
'                Face.AddPointAndNormal Along*FacePoints+Around+1,0 
'                Face.AddPointAndNormal (Along-1)*FacePoints+Around+1,0   
'              end if
            
'         Next 'Around

'whoops the wrong way around                               
  
        For Around = 0 to FacePoints-1
            'make a face using points from here and previous face
            'add it to object  
              Set Face = Object.CreateFace
              
              
              'need to trap the last face to use the points of the first face?
              if Around=(FacePoints-1) then
                Face.AddPointAndNormal (Along-1)*FacePoints,0 
                Face.AddPointAndNormal Along*FacePoints,0
                
              else  
                Face.AddPointAndNormal (Along-1)*FacePoints+Around+1,0   
                Face.AddPointAndNormal Along*FacePoints+Around+1,0 
              
              end if
               Face.AddPointAndNormal Along*FacePoints+Around,0 
               Face.AddPointAndNormal (Along-1)*FacePoints+Around,0                    
              Face.SetMaterial Material 
         Next 'Around

       
        'The previous NewCentre and axis has to become the old centre and axis     
         For Around=0 to 2
              Centre(Around)=Newcentre(Around)
              Axis(Around)=NewAxis(Around)
         Next   'Around     
         'The first point also has to be updated
         Object.GetPoint Along*FacePoints,FirstPoint(0),FirstPoint(1),FirstPoint(2)
    Next  'Along

   'we have to add it to the model

        'add the object to the created Group
        'this also triggers the update to the database
        Group.AddObject Object

        'set the object name - note that we can't do this until
        'the object is added to a Group
        Object.SetName "Squiggly thing"

   End If

''myfile.Close
End Sub

Sub createMaterial

      'Create an appropriate material for the face
        Set Material = Scene.CreateMaterial

        'make it a nice color
        Material.SetColor .894,.773,.788

        'set the default diffuse value
        Material.SetDiffuse 60

        'set the default ambient value
        Material.SetAmbient 20

End sub

Sub SetMaterial

NewFace.SetMaterial(Material(0))

End sub


Function ArcSin(a)
    'Inverse Sine Function
    ArcSin = Atn(a / Sqr(1 - a * a))
End Function


Function ArcCos(a) 
    'Inverse Cosine Function
'msgbox(a)

    If a = 1 Then
        ArcCos = 0
    Else
        ArcCos = 2 * Atn(1) - Atn(a / Sqr(1 - a * a))
    End If
End Function

Function LawOfCosines(a,b,c)
'Ouput is the angle C of a triangle of sides a,b,c
LawOfCosines=ArcCos((a^2+b^2-c^2)/(2*a*b))
End Function  


Function DotProduct(v1(),v2())
dim i
dim temp
temp=0
for i=0 to 2
 temp=temp+v1(i)*v2(i)
next
DotProduct=temp
end function


   
Sub Cross(v1(), v2(), nx,ny,nz)      'Calculates a crossproduct of two vectors
nx = ( v1(1) * v2(2) ) - ( v1(2) * v2(1) )
ny = ( v1(2) * v2(0) ) - ( v1(0) * v2(2) )
nz = ( v1(0) * v2(1) ) - ( v1(1) * v2(0) )

end sub



Sub CrossVecOut(v1(), v2(), vn())      'Calculates a crossproduct of two vectors
vn(0)= ( v1(1) * v2(2) ) - ( v1(2) * v2(1) )
vn(1) = ( v1(2) * v2(0) ) - ( v1(0) * v2(2) )
vn(2) = ( v1(0) * v2(1) ) - ( v1(1) * v2(0) )

end sub

Sub NormaliseVec (v())
dim CamNorm
   'Normalize the vector
         CamNorm=sqr(v(0)^2+v(1)^2+v(2)^2)
         v(0)=v(0)/CamNorm
         v(1)=v(1)/CamNorm  
         v(2)=v(2)/CamNorm 
end sub

'*****************************************************************************
'FUNNY FUNCTIONS TO DO THE WEIRD STUFF

'sub FindNewCentre  (N(),C())

'N(0)=C(0)+0
'N(1)=C(1)+1
'N(2)=C(2)+0
'end sub

'sub FindNewCentre  (N(),C())

'N(0)=C(0)+1
'N(1)=C(1)+1
'N(2)=C(2)+0
'end sub

sub CorkScrew  (N(),C())
'sin wave or corkscrew
N(0)=C(0)+1
N(1)=C(1)+sin(C(0))
N(2)=C(2)+cos(C(0))
end sub


sub CorkScrew2  (N(),C())
'sin wave or corkscrew
N(0)=C(0)+1
N(1)=C(1)-(sin(C(0))*C(0))
N(2)=C(2)+(cos(C(0))* C(0))
end sub

'sub BellCurve  (N(),C())
'Normal Curve   '    NOT WORKING !!

'Dim sd   'standard deviation
'Dim mean

'sd=2
'mean=20

'N(0)=C(0)+1
'N(1)=C(1)+(1/(sqr(2*Pi*sd^2)))*exp(   (-1*  (C(0)-mean)^2)  /  (2*sd^2)     )
'N(2)=C(2)
'end sub