Attribute VB_Name = "CoffeeTime"
'       This is a part of the source code for Pro/DESKTOP.
'       Copyright (C) 1999 Parametric Technology Corporation.
'       All rights reserved.

Dim app As ProDESKTOP
Dim ctImageC As ImageClass
Dim ctMatrixC As MatrixClass
Dim ctColorC As ColorClass
Dim ctBgC As BackgroundShaderClass
Dim ctPtC As PointClass
Dim ctVectorC As VectorClass

Private Sub Init() 'initialize
    Set app = CreateObject("ProDESKTOP.Application")
    app.SetVisible True
    Set ctImageC = app.GetClass("Image")
    Set ctMatrixC = app.GetClass("Matrix")
    Set ctColorC = app.GetClass("Color")
    Set ctBgC = app.GetClass("BackgroundShader")
    Set ctPtC = app.GetClass("Point")
    Set ctVectorC = app.GetClass("Vector")
End Sub

Private Function ctLoad(name)
    'This is where the directory is set to find the assembly file.
    'The Name variable is the name of the assembly.  It can be changed below in the name function
    CtDir = "C:\Program Files\PTC\ProDESKTOP 2000i2\Samples\"
    Dim ctdoc As PartDocument
    Set ctdoc = app.OpenPart(CtDir + name + ".des")
    If ctdoc Is Nothing Then
        MsgBox "Error opening " + CtDir + name + "Please specify the Tutorials directory of Pro/DESKTOP"
        End
    End If
    Set ctLoad = ctdoc
End Function
Private Function ctFind(name)
    Dim ctdoc As PartDocument
    Set ctdoc = ctLoad(name)
    Dim ctDes As aDesign
    Set ctDes = ctdoc.GetDesign
    Set ctFind = ctDes
End Function

Sub CoffeeTime()
    Call Init
    
    Dim helm As helm
    Set helm = app.TakeHelm

    ' Load coffee time design
    Dim ctdoc As PartDocument
    Dim ctDes As aDesign
    
        Set ctdoc = ctLoad("coffee-time")
    Set ctDes = ctdoc.GetDesign
    
    'Make a lovely album
    Dim ctAlbumDoc As AlbumDocument
    Set ctAlbumDoc = app.NewAlbum
    Dim ctAlbum As aAlbum
    Set ctAlbum = ctAlbumDoc.GetAlbum
    Dim ctImage As aImage
    Set ctImage = ctImageC.CreateImage(ctAlbum, ctDes)
    ctImage.SetWidth (800)
    ctImage.SetHeight (600)
  
    'Right here is where you can change the assembly name
    'Note that it will look in the directory set above
    ctImage.SetName "Coffee Time" '<-----ASSEMBLY NAME
    Dim orient As zMatrix
    Set orient = ctMatrixC.CreateMatrix(Sqr(3) / 2, 0.5, 0, 0, -0.25, Sqr(3) / 4, Sqr(3) / 2, 0, Sqr(3) / 4, -0.75, 0.5, 0, 0, 0, 0, 1)
    ctImage.SetViewTransformation orient
    ctImage.AutoScale 0.95
    
    'Apply sensible materials
    'This applies materials to components inside the assembly.
    'If you change the assembly you must change this!
    'Note that in the ctFind function is the name of components!
    ctImage.SetMaterial ctFind("spoon"), ctAlbumDoc.GetMaterialByName("chromium plate"), False
    ctImage.SetMaterial ctFind("coffee-mug"), ctAlbumDoc.GetMaterialByName("steel, stainless"), False
    ctImage.SetMaterial ctFind("coffee"), ctAlbumDoc.GetMaterialByName("iron, cast"), False
    ctImage.SetMaterial ctFind("coffee-tray-base"), ctAlbumDoc.GetMaterialByName("wood, plain"), False
    ctImage.SetMaterial ctFind("coffe-tray-edge"), ctAlbumDoc.GetMaterialByName("wood, plain"), False
    ctImage.SetMaterial ctFind("coffee-tray-end"), ctAlbumDoc.GetMaterialByName("wood, plain"), False
    ctImage.SetMaterial ctFind("coffee-pot"), ctAlbumDoc.GetMaterialByName("ceramic"), False
    ctImage.SetMaterial ctFind("coffee-pot-lid"), ctAlbumDoc.GetMaterialByName("ceramic"), False
    ctImage.SetMaterial ctFind("napkin"), ctAlbumDoc.GetMaterialByName("wrapped checker"), False
    
    'This creates the background for the album
    'Pick a color name then specify the color using RGB values
    Set lightblue = ctColorC.CreateColor(0, 200, 100, 255)
    Set darkblue = ctColorC.CreateColor(0, 0, 0, 200)
    Set graduated = ctBgC.CreateGraduatedShader(lightblue, darkblue)
    ctImage.SetBackground graduated
    
    'This sets the colored lights
    'Pick a color name then set the color via RGB values
    Set redlight = ctColorC.CreateColor(0, 255, 0, 0)
    Set greenlight = ctColorC.CreateColor(0, 0, 255, 0)
    Set bluelight = ctColorC.CreateColor(0, 0, 0, 255)
    
    'Set the lights in a position then point them in a direction
    'Set __Pt puts the light in a certain location
    'Set __To points the light in a direction
    
    Set redPt = ctVectorC.CreateVector(0, 0, 0.5)
    Set redTo = ctVectorC.CreateVector(0.1, 0, 0)
    Set greenPt = ctVectorC.CreateVector(0, 0, 0.5)
    Set greenTo = ctVectorC.CreateVector(-0.1, 0, 0)
    Set bluePt = ctVectorC.CreateVector(0, 0, 0.5)
    Set blueTo = ctVectorC.CreateVector(-0.1, 0.1, 0)
    
    ctImage.RemoveLights
    
    'Add the lights into the Rendering
    ctImage.AddLight 6, 0, redlight, True, 0, redPt, redTo, 45
    ctImage.AddLight 6, 0, greenlight, True, 0, greenPt, greenTo, 45
    ctImage.AddLight 6, 0, bluelight, True, 0, bluePt, blueTo, 45
    
    ctImage.SetRenderMode 5 '8
    ctImage.Render
    
    helm.CommitCalls "Album Example", False
End Sub