[vtkusers] Simple molecular model

[John Wooten]

I'm trying to build a simple molecular model in Visual Basic so I can use
the ActiveViz component to put the resulting model into a word document.  I
want to have very simple balls ( atoms ) with different potential colors,
but each atom with a label that "sticks" to it.  The balls are connected via
tubes.  i.e. the input data might be

atoms(0) = 0,0,0 ( i.e. position )
atoms(1) = -5, 0, 0
atoms(2) = 0, 0, 5

colors(0) = "Blue"
colors(1) = "Red"
colors(2) = "Green"

labels(0) = "Hydrogen"
labels(1) = "Oxygen"
labels(2) = "Lithium"

connects(0) = 0, 1 ( i.e. 0 is connected to 1 )
connects(1) = 0, 2 ( i.e. 0 is connected to 2 ).

My problem has been the labeling mostly.  Does anyone have a way to adapt
this piece of code or perhaps a better approach?  I'd love the have the
labels "wrapped" onto the surface of the object rather than hanging out in
front.

Code --------------------------------------------

Private Sub CommandButton2_Click()

Set renWin = vtkRenderWindowControl1.GetRenderWindow
Set renCollection = renWin.GetRenderers
renCollection.InitTraversal
Set ren1 = renCollection.GetNextItem
ren1.ResetCamera
renWin.Render

End Sub

Private Sub CommandButton1_Click()


Rem Create the rendering stuff-------------------------------------
Set renWin = vtkRenderWindowControl1.GetRenderWindow
Set renCollection = renWin.GetRenderers
renCollection.InitTraversal
Set ren1 = renCollection.GetNextItem

Rem create the positions of the atoms in a vtkPoints data set
Dim atoms As vtkPoints
Set atoms = New vtkPoints
  atoms.InsertPoint 0, 0, 0, 0
  atoms.InsertPoint 1, 0, 0, 5
  atoms.InsertPoint 2, 10, 0, 0
  atoms.InsertPoint 3, 0, 5, 0
  atoms.InsertPoint 4, 5, 10, 5
  atoms.InsertPoint 5, 5, 10, -5

Rem create the bonds between the atoms as a cell array
Dim bonds As vtkCellArray
Set bonds = New vtkCellArray
  bonds.InsertNextCell_3 2
  bonds.InsertCellPoint 0
  bonds.InsertCellPoint 1
  bonds.InsertNextCell_3 2
  bonds.InsertCellPoint 0
  bonds.InsertCellPoint 2
  bonds.InsertNextCell_3 2
  bonds.InsertCellPoint 0
  bonds.InsertCellPoint 3
  bonds.InsertNextCell_3 2
  bonds.InsertCellPoint 3
  bonds.InsertCellPoint 4
  bonds.InsertNextCell_3 2
  bonds.InsertCellPoint 3
  bonds.InsertCellPoint 5

Rem create the radii for the atoms as a float array
Dim radii As vtkFloatArray
Set radii = New vtkFloatArray
  radii.SetName "Radius"
  radii.InsertNextTuple1 3
  radii.InsertNextTuple1 2
  radii.InsertNextTuple1 1
  radii.InsertNextTuple1 2
  radii.InsertNextTuple1 1
  radii.InsertNextTuple1 1


Rem create a polydata with the atoms as points, bonds as lines and radii as
scalars
Dim Data As vtkPolyData
Set Data = New vtkPolyData
  Data.SetPoints atoms
  Data.SetLines bonds
  Data.GetPointData().SetScalars radii

Rem create a tube filter to create tubes around the lines
Dim Tuber0 As vtkTubeFilter
Set Tuber0 = New vtkTubeFilter
  Tuber0.SetInput Data
  Tuber0.SetNumberOfSides 12
  Tuber0.SetCapping 1
  Tuber0.SetRadius 0.25
  Tuber0.SetVaryRadius 0
  Tuber0.SetRadiusFactor 10

Rem create a mapper for the bonds or tubes output
Dim bondsMapper As vtkPolyDataMapper
Set bondsMapper = New vtkPolyDataMapper
  bondsMapper.SetInput Tuber0.GetOutput
bondsMapper.ScalarVisibilityOff
Rem create an actor for the bonds
Dim bondsActor As vtkActor
Set bondsActor = New vtkActor
  bondsActor.SetMapper bondsMapper

Rem create a sphere source for use with the glypher
Dim Sphere0 As vtkSphereSource
Set Sphere0 = New vtkSphereSource
        Sphere0.SetCenter 0, 0, 0
        Sphere0.SetRadius 0.5
        Sphere0.SetThetaResolution 20
        Sphere0.SetStartTheta 0
        Sphere0.SetEndTheta 360
        Sphere0.SetPhiResolution 20
        Sphere0.SetStartPhi 0
        Sphere0.SetEndPhi 180

Rem Create a glph to display the spheres
Dim Glyph1 As vtkGlyph3D
Set Glyph1 = New vtkGlyph3D
  Glyph1.SetInput Data
  Glyph1.SetSource Sphere0.GetOutput
  Glyph1.SetOrient 0
  Glyph1.SetScaleModeToScaleByScalar
  Glyph1.SetScaleFactor 1.5

Rem create a mapper to display the glyphs or atoms
Dim atomMapper As vtkPolyDataMapper
Set atomMapper = New vtkPolyDataMapper
  atomMapper.SetInput Glyph1.GetOutput
atomMapper.ScalarVisibilityOff
Rem create an actor for the mapper
Dim atomActor As vtkActor
Set atomActor = New vtkActor
  atomActor.SetMapper atomMapper

bondsActor.GetProperty.SetColor 0#, 0#, 1#

Rem add the two actors
  ren1.AddActor bondsActor
  ren1.AddActor atomActor

Rem set the background
ren1.SetBackground 0.1, 0.2, 0.4

Rem  render the image
Set cam = ren1.GetActiveCamera
cam.Zoom 1.5
cam.Azimuth 150
cam.Elevation 30
ren1.ResetCamera
renWin.Render


End Sub

Private Sub CommandButton3_Click()

If renWin Is Nothing Then

Else

Set renWin = vtkRenderWindowControl1.GetRenderWindow
Set renCollection = renWin.GetRenderers
renCollection.InitTraversal
Set ren1 = renCollection.GetNextItem
Set cam = ren1.GetActiveCamera

Dim Angle As Single
For i = 1 To 60
   cam.Azimuth 6
   renWin.Render
Next

End If

End Sub

Private Sub vtkRenderWindowControl1_StartRenderMethod()

End Sub


============================
Thanks in advance,

John Wooten