Internet Magazine 2003 September/INTERNET107.ISO/pc/software/windows/multimed/3d_canvas/3dcanvas.msi/Instal01.cab/_5BF6647D067740F6B465E5367E0E6ED4

Visual Basic class definition | 2002-06-04 | 8.5 KB | 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_Main(Canvas As CanvasApplication _
, UserDataString As String _
, UserDataSingles() As Single _
, UserDataLongs() As Long)

    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.AddNormal 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.AddPoint -0.5, -0.5, 0
            Object.AddPoint -0.5, 0.5, 0
            Object.AddPoint 0.5, 0.5, 0
            Object.AddPoint 0.5, -0.5, 0

            'add the points and the normal to the face
            Face.AddPointAndNormal 0, 0
            Face.AddPointAndNormal 1, 0
            Face.AddPointAndNormal 2, 0
            Face.AddPointAndNormal 3, 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.AddPoint NewPointX, NewPointY, NewPointZ

                'add the point to the face
                Face.AddPointAndNormal Point, 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