home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 2007 January
/
PCWorld_2007-01_cd.bin
/
multimedia
/
3dcanvas
/
3DCanvas.msi
/
Instal01.cab
/
_5BF6647D067740F6B465E5367E0E6ED4
< prev
next >
Wrap
Text File
|
2006-11-03
|
9KB
|
217 lines
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "CreateFace"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'*********************************************************************************
' In order to provide clear examples this sample code does not incluce any
' error handling.
'
' Note that typed variables are used in this example. The scripting references
' does not type variables since scripting does not permit the use of typed
' variables. Visual Basic can automatically translate from the format the API
' provides (usually Variants) to the appropriate type. If you are using a language
' other than Visual Basic you will likely have to do this yourself.
'*********************************************************************************
Implements Plugin
'*********************************************************************************
' Module Level Constants
'*********************************************************************************
Const mstrcModule As String = "CreateFace"
'*********************************************************************************
' Class Events
'*********************************************************************************
'*********************************************************************************
' Implemented Functions
'*********************************************************************************
'*********************************************************************************
' Purpose: Creates a Face
'*********************************************************************************
Private Sub Plugin_Apply(Canvas As CanvasApplication _
, UserDataSingles() As Single _
, UserDataLongs() As Long _
, UserDataString As String)
Dim Scene As CanvasScene 'The current active scene
Dim SceneRootGroup As CanvasGroup 'The root Group of the scene
Dim Group As CanvasGroup 'The Group for our object (face)
Dim Object As CanvasObject 'The object we are creating (face)
Dim Face As CanvasFace 'The face we are creating
Dim GridOriginX As Single 'The 3D Canvas Grid's Origin (x)
Dim GridOriginY As Single 'The 3D Canvas Grid's Origin (y)
Dim GridOriginZ As Single 'The 3D Canvas Grid's Origin (z)
Dim GridSize As Single 'The 3D Canvas Grid's Size
Dim GridInterval As Single 'The 3D Canvas Grid's Interval
Dim Points As String 'The user's desired # of points
Dim NumericPoints As Long 'Points converted to a number
Dim FirstPointX As Single 'First point in face
Dim FirstPointY As Single 'First point in face
Dim FirstPointZ As Single 'First point in face
Dim AxisX As Single 'Axis to rotate the start position around
Dim AxisY As Single 'Axis to rotate the start position around
Dim AxisZ As Single 'Axis to rotate the start position around
Dim Point As Long 'Point we are creating
Dim NewPointX As Single 'Point to add
Dim NewPointY As Single 'Point to add
Dim NewPointZ As Single 'Point to add
Dim BoxMinX As Single 'The Object's Bounding Box
Dim BoxMinY As Single 'The Object's Bounding Box
Dim BoxMinZ As Single 'The Object's Bounding Box
Dim BoxMaxX As Single 'The Object's Bounding Box
Dim BoxMaxY As Single 'The Object's Bounding Box
Dim BoxMaxZ As Single 'The Object's Bounding Box
Dim Material As CanvasMaterial 'The Face's Material
'ask the user how many points s/he wants
Do
Points = InputBox("How many points would you like in the face?", , "4")
'if they entered anything
If Points <> "" Then
'they could have entered anything so ensure it is valid
On Error Resume Next
NumericPoints = CLng(Points)
Err.Clear
On Error GoTo 0
'Let them know we had a problem
If NumericPoints < 3 Then
MsgBox "3 is the minimum number of points", vbInformation
End If
End If
Loop Until NumericPoints >= 3 Or Points = ""
'If they entered anything continue
If Points <> "" Then
'get the scene
Set Scene = Canvas.GetActiveScene
'get the root Group
Set SceneRootGroup = Scene.GetRootGroup
'create a Group for the object (face)
Set Group = Scene.CreateGroup
'add it to the scene
SceneRootGroup.AddChild Group
'give the Group a name - note that we can't do this
'until the Group is added to the scene
Group.SetName "Face Group"
'create an object
Set Object = Scene.CreateObject()
'add the face to the object
Set Face = Object.CreateFace
'add a dummy normal to the object (we need one to add the points)
Object.AddOptimizedNormal 0, 0, -1
'set the FirstPoint
FirstPointX = 0
FirstPointY = 0.5
FirstPointZ = 0
'we're going to make an exception if they want four faces
'a quad will look wrong if we just rotate around a point
If NumericPoints = 4 Then
'add the quad points to the object
Object.AddOptimizedPoint -0.5, -0.5, 0
Object.AddOptimizedPoint -0.5, 0.5, 0
Object.AddOptimizedPoint 0.5, 0.5, 0
Object.AddOptimizedPoint 0.5, -0.5, 0
'add the points and the normal to the face
Face.AddPointIndexed 0, 0, 0
Face.AddPointIndexed 1, 0, 0
Face.AddPointIndexed 2, 0, 0
Face.AddPointIndexed 3, 0, 0
Else
'add the points to the object
For Point = 0 To NumericPoints - 1
'rotate the FirstPoint to get a NewPoint
Canvas.RotatePoint FirstPointX, FirstPointY, FirstPointZ, 0, 0, -1, 6.2831853 / NumericPoints * Point, NewPointX, NewPointY, NewPointZ
'add the NewPoint to the object
Object.AddOptimizedPoint NewPointX, NewPointY, NewPointZ
'add the point to the face
Face.AddPointIndexed Point, 0, 0
Next
End If
'Create an appropriate material for the face
Set Material = Scene.CreateMaterial
'make it a nice color
Material.SetColor 0.894, 0.773, 0.788
'set the default diffuse value
Material.SetDiffuse 60
'set the default ambient value
Material.SetAmbient 20
'apply the material to the face
Face.SetMaterial Material
'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 "Face"
'Now that we know the size of the object let's set the position of the Group
'so the face is visible
'get the 3D Canvs grid details
Canvas.GetGridDetails GridOriginX, GridOriginY, GridOriginZ, GridSize, GridInterval
'get the object's dimensions
Object.GetBoundingBox BoxMinX, BoxMinY, BoxMinZ, BoxMaxX, BoxMaxY, BoxMaxZ
'Center the Object's Group on the Scene and have the object sitting nicely
'on the surface
Group.SetPosition SceneRootGroup, 0, GridOriginX + GridSize / 2, GridOriginY - BoxMinY, GridOriginZ + GridSize / 2
End If
End Sub
'*********************************************************************************
' Purpose: Identifies the name of the plug-in to 3D Canvas
'*********************************************************************************
Private Function Plugin_GetName() As String
Plugin_GetName = "Create Face"
End Function
'*********************************************************************************
' Purpose: Identifies the author of the plug-in to 3D Canvas
'*********************************************************************************
Private Function Plugin_GetAuthor() As String
Plugin_GetAuthor = "Amabilis Software"
End Function