PPT2000: Add-in Rotates 3-D Objects in One-degree Increments

ID: Q222725

The information in this article applies to:

Microsoft PowerPoint 2000

SUMMARY

An add-in for PowerPoint 97 that allows you to rotate three-dimensional (3-D) objects in one-degree increments is available to download from the Microsoft Software Library (MSL):

~ three-d.exe 75 KB self-extracting file

This self-extracting file contains the following three files:

ThreeD.ppt

ThreeD.ppa

Readme.txt

For more information about downloading files from the Microsoft Software Library, please see the following article in the Microsoft Knowledge Base:

Q119591 How to Obtain Microsoft Support Files from Online Services

MORE INFORMATION

Microsoft provides programming examples for illustration only, without warranty either expressed or implied, including, but not limited to, the implied warranties of merchantability and/or fitness for a particular purpose. This article assumes that you are familiar with the programming language being demonstrated and the tools used to create and debug procedures. Microsoft Support professionals can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific needs. If you have limited programming experience, you may want to contact the Microsoft fee-based consulting line at (800) 936-5200. For more information about the support options available from Microsoft, please see the following page on the World Wide Web:

http://www.microsoft.com/support/supportnet/overview/overview.asp

NOTE: The following macro examples only work from within the PowerPoint application. Visual Basic for Applications macros are not supported by the Microsoft PowerPoint Viewer. For additional information, please see the following article in the Microsoft Knowledge Base:

Q230746 PPT: Viewer: Presentation Macros Don't Run

Contents of the Readme.txt file

The following information is the complete text of the Readme.txt file:

------------------------

HOW TO USE THIS DOCUMENT

To view the Readme.txt file, open it in Notepad.

To print Readme.txt, open it in Notepad or another word processor, and then click Print on the File menu.

--------

WHAT IS A POWERPOINT ADD-IN?

HOW TO LOAD THE ADD-IN

HOW TO USE THREED.PPA

THE SOURCE CODE
- The Code in the Form
- The Code in the Module

HOW TO REMOVE THE ADD-IN

SUPPORT AND INFORMATION

WHAT IS A POWERPOINT ADD-IN?

Add-ins are supplemental programs that extend the capabilities of PowerPoint by adding custom commands and specialized features. You can obtain add-ins from independent software vendors or you can write your own.

HOW TO LOAD THE ADD-IN

To use an add-in, you must first install it on your computer and then load it into PowerPoint. PowerPoint add-ins have the file name extension .ppa. To load the ThreeD.ppa add-in, use these steps:

Start PowerPoint.

On the Tools menu, click Add-Ins.

Click Add New.

In the Add New PowerPoint Add-In dialog box, select the ThreeD.ppa file and then click OK.

In the Macro Warning message box, click Enable Macros. NOTE: ThreeD.ppa contains macro code. Enable Macros must be selected for the add-in to run correctly.

Click Close.

The ThreeD.ppa add-in is now loaded into PowerPoint. The 3-D Rotation command has been added to the Tools menu.

HOW TO USE THREED.PPA

By default, PowerPoint allows you to rotate objects in five-degree increments. The ThreeD.ppa add-in allows you to rotate three-dimensional (3-D) objects in one-degree increments. You cannot use this command to rotate one-dimensional (1-D) objects. To apply a 3-D effect to a 1-D object, use these steps:

Add a drawing object to a slide.

Select the object.

On the Drawing toolbar, click the 3-D button, and then click one of the 3-D styles. NOTE: If the 3-D styles are unavailable, you cannot apply a 3-D effect to the selected object, or you have not selected an object.

To rotate the 3-D object in one-degree increments, using the 3-D Rotation command, use these steps:

Select a 3-D object.

On the Tools menu, click 3-D Rotation.

In the Rotate 3D Axis dialog box, type a value for the X, Y, and Z axes. The X, Y, and Z axes represent the height, width, and depth axes, respectively.

Optional: Click to select the Animate Rotation check box if you want to animate the object while the rotation effect is applied. NOTE: After the rotation effect is applied, the object will not continue to be animated.

Click Preview to see how the values affect the rotation of the object.
NOTE: You can click Reset if you want to return the object to its original settings, or click Cancel to close the dialog box without making changes to the object.

Click OK to apply the values you set.

THE SOURCE CODE

The Code in the Form


   'Define default axis variables, to store initial X,Y positions
   'of the object being rotated.
   Dim defX As Integer
   Dim defY As Integer
   Dim defZ As Integer
   Dim objName As String

   'Define variables used for rotation.
   Dim newX As Integer
   Dim newY As Integer
   Dim newZ As Integer

   'Define variables used in error checking.
   Dim lastX As Integer
   Dim lastY As Integer
   Dim lastZ As Integer
'--------------------------------------------------------------
' Procedure:      Cancelbut_Click()
' Arguments:      none
' Description:    Resets the object back to the original X-Y-Z
'        coordinates and then unloads the form.
'--------------------------------------------------------------

Private Sub Cancelbut_Click()
   ActiveWindow.Selection.ShapeRange.ThreeD.RotationX = defX
   ActiveWindow.Selection.ShapeRange.ThreeD.RotationY = defY
   ActiveWindow.Selection.ShapeRange.Rotation = defZ
   Unload Me
End Sub
'--------------------------------------------------------------
' Procedure:      cmdReset_Click()
' Arguments:      none
' Description:    Resets the object back to the original X-Y-Z
'        coordinates and sets the axis of the text
'        boxes back to their original values.
'--------------------------------------------------------------

Private Sub cmdReset_Click()
   If chkFancy.Value = True Then
      newX = Xaxis.Value
      newY = Yaxis.Value
      newZ = Zaxis.Value
      FancyRot defX, defY, defZ
   Else
      ActiveWindow.Selection.ShapeRange.ThreeD.RotationX = defX
      ActiveWindow.Selection.ShapeRange.ThreeD.RotationY = defY
      ActiveWindow.Selection.ShapeRange.Rotation = defZ
   End If

   cmdReset.Enabled = False
   Xaxis.Value = defX
   Yaxis.Value = defY
   Zaxis.Value = defZ

End Sub

'--------------------------------------------------------------
' Procedure:      OKbut_Click()
' Arguments:      none
' Description:    Run RotMe subroutine and then unload
'                 the form.
'--------------------------------------------------------------

Private Sub OKbut_Click()
   RotMe
   Unload Me
End Sub

'--------------------------------------------------------------
' Procedure:      preview_Click()
' Arguments:      none
' Description:    Runs RotMe so user can see if rotation is
'                 acceptable.
'--------------------------------------------------------------

Private Sub preview_Click()
   RotMe
   cmdReset.Enabled = True
End Sub

'--------------------------------------------------------------
' Procedure:      SpinButton1_SpinDown()
' Arguments:      none
' Description:    Nudge down Y axis value. Make sure the axis
'           value fits within boundry.
'--------------------------------------------------------------

Private Sub SpinButton1_SpinDown()
   Yaxis.Value = Yaxis.Value - SpinButton1.SmallChange
   If Yaxis.Value < -90 Then
      Yaxis.Value = -90
   End If
End Sub

'--------------------------------------------------------------
' Procedure:      SpinButton1_SpinUp()
' Arguments:      none
' Description:    Nudge up Y axis value. Check for bounds.
'--------------------------------------------------------------

Private Sub SpinButton1_SpinUp()
   Yaxis.Value = Yaxis.Value + SpinButton1.SmallChange
   If Yaxis.Value > 90 Then
      Yaxis.Value = 90
   End If
End Sub

'--------------------------------------------------------------
' Procedure:      SpinButton2_SpinDown()
' Arguments:      none
' Description:    Nudge down X axis value. Check for bounds.
'--------------------------------------------------------------

Private Sub SpinButton2_SpinDown()
   Xaxis.Value = Xaxis.Value - SpinButton2.SmallChange
   If Xaxis.Value < -90 Then
      Xaxis.Value = -90
   End If
End Sub

'--------------------------------------------------------------
' Procedure:      SpinButton2_SpinUp()
' Arguments:      none
' Description:    Nudge up X axis value. Check for bounds.
'--------------------------------------------------------------

Private Sub SpinButton2_SpinUp()
   Xaxis.Value = Xaxis.Value + SpinButton2.SmallChange
   If Xaxis.Value > 90 Then
      Xaxis.Value = 90
   End If
End Sub

'--------------------------------------------------------------
' Procedure:      SpinButton3_SpinDown()
' Arguments:      none
' Description:    Nudge down Z axis value. Check for bounds.
'--------------------------------------------------------------

Private Sub SpinButton3_SpinDown()
   Zaxis.Value = Zaxis.Value - SpinButton3.SmallChange
End Sub

'--------------------------------------------------------------
' Procedure:      SpinButton3_SpinDown()
' Arguments:      none
' Description:    Nudge up Z axis value. Check for bounds.
'--------------------------------------------------------------

Private Sub SpinButton3_SpinUp()
   Zaxis.Value = Zaxis.Value + SpinButton3.SmallChange
End Sub

'--------------------------------------------------------------
' Procedure:      UserForm_Activate()
' Arguments:      none
' Description:    Grab X, Y, Z axis coordinates for object.
'                 Set text boxes to same numbers.
'        Set reserved variables.
'--------------------------------------------------------------

Private Sub UserForm_Activate()
   defX = ActiveWindow.Selection.ShapeRange.ThreeD.RotationX
   defY = ActiveWindow.Selection.ShapeRange.ThreeD.RotationY
   If ActiveWindow.Selection.ShapeRange.Rotation > 180 Then
      defZ = ActiveWindow.Selection.ShapeRange.Rotation - 360
   Else
      defZ = ActiveWindow.Selection.ShapeRange.Rotation
   End If
   Xaxis.Value = defX
   Yaxis.Value = defY
   Zaxis.Value = defZ
   lastX = defX
   lastY = defY
   lastZ = defZ
   objName = ActiveWindow.Selection.ShapeRange.Name
   cmdReset.Enabled = False
End Sub

'--------------------------------------------------------------
' Procedure:      RotMe()
' Arguments:      none
' Description:    Is the default rotation procedure. It checks
'                 to make sure that the object is in bounds.
'--------------------------------------------------------------

Function RotMe()
   Dim x As Integer
   Dim y As Integer
   Dim z As Integer
   Dim i As Integer
   Dim k As Integer

   'Is it Blank?
   'yes, set to zero
   'else set to axis value.
   On Error Resume Next
   Err.Clear

   If Xaxis.Value = "" Then

      x = 0
      Xaxis.Value = x

   Else

      x = Xaxis.Value

   End If

   If Yaxis.Value = "" Then

      y = 0
      Yaxis.Value = y

   Else

      y = Yaxis.Value

   End If

   If Zaxis.Value = "" Then

      z = 0
      Zaxis.Value = z

   Else

      z = Zaxis.Value

   End If

   If Err.Number <> 0 Then

      MsgBox "Please enter a value between -90 and +90"
      Xaxis.Value = lastX
      Yaxis.Value = lastY
      Zaxis.Value = lastZ

   Else

      'Is it bigger than 90?
      'yes, then set it to 90
      'no, is it less than -90
      'yes, then set it to -90
      If Xaxis.Value > 90 Then
         x = 90
         Xaxis.Value = x
      Else
         If Xaxis.Value < -90 Then
            x = -90
            Xaxis.Value = x
         End If
      End If

      If Yaxis.Value > 90 Then
         y = 90
         Yaxis.Value = y
      Else
         If Yaxis.Value < -90 Then
            y = -90
            Yaxis.Value = y
         End If
      End If

      If Zaxis.Value > 360 Then
         z = Zaxis.Value - 360
         Zaxis.Value = z
      Else
         If Zaxis.Value < -360 Then
            z = Zaxis.Value + 360
            Zaxis.Value = z
         End If
      End If

      'Set axis to new location.
      If chkFancy.Value = True Then
         newX = ActiveWindow.Selection.ShapeRange.ThreeD.RotationX
         newY = ActiveWindow.Selection.ShapeRange.ThreeD.RotationY
         If ActiveWindow.Selection.ShapeRange.Rotation = lastZ Then
            newZ = ActiveWindow.Selection.ShapeRange.Rotation
         Else
            newZ = lastZ
         End If
         FancyRot x, y, z
      Else
         ActiveWindow.Selection.ShapeRange.ThreeD.RotationY = y
         ActiveWindow.Selection.ShapeRange.ThreeD.RotationX = x
         ActiveWindow.Selection.ShapeRange.Rotation = z
      End If
      lastX = x
      lastY = y
      lastZ = z

   End If

End Function

'--------------------------------------------------------------
' Procedure:      FancyRot()
' Arguments:      [x] The new x coordinate.
'             [y] The new y coordinate.
'                 [z] The new z coordinate.
' Description:    Does the on-screen rotation animation.
'--------------------------------------------------------------

Function FancyRot(x As Integer, y As Integer, z As Integer)
   Dim Ix As Integer
   Dim Iy As Integer
   Dim Iz As Integer
   Dim Kx As Integer
   Dim Ky As Integer
   Dim Kz As Integer

   'Checks to see if current location, newX, is greater than
   'or equal to x. If it's greater, set Kx to decrement the
   'rotation loop by 1. Otherwise, increment the loop by 1.
   If newX >= x Then

      Kx = -1

   Else

      Kx = 1

   End If

   'Checks to see if current location, newY, is greater than
   'or equal to y. If it's greater, set Ky to decrement the
   'rotation loop by 1. Otherwise, increment the loop by 1.
   If newY >= y Then

      Ky = -1

   Else

      Ky = 1

   End If

   'Checks to see if current location, newZ, is greater than
   'or equal to z. If it's greater, set Kz to decrement the
   'rotation loop by 1. Otherwise, increment the loop by 1.
   If newZ >= z Then

      Kz = -1

   Else

      Kz = 1

   End If

   'Loop through all three axes one at a time, and display
   'the animation by selecting and deslecting the object.
   With ActiveWindow.Selection

      For Iy = newY To y Step Ky
         .SlideRange.Shapes(objName).Select
         .ShapeRange.ThreeD.RotationY = Iy
         .Unselect
      Next Iy

      For Ix = newX To x Step Kx
         .SlideRange.Shapes(objName).Select
         .ShapeRange.ThreeD.RotationX = Ix
         .Unselect
      Next Ix

      For Iz = newZ To z Step Kz
        .SlideRange.Shapes(objName).Select
        .ShapeRange.Rotation = Iz
        .Unselect
      Next Iz

      .SlideRange.Shapes(objName).Select

   End With

The Code in the Module



'--------------------------------------------------------------
' Procedure:      LaunchRot()
' Arguments:      none
' Description:    Makes sure the selection is valid and then
'                 load the main form.
'--------------------------------------------------------------

Sub LaunchRot()

   On Error Resume Next
   Err.Clear

   Dim not3d As Boolean

   'Tests to see if the object selected is a shape
   If ActiveWindow.Selection.Type = ppSelectionShapes Then

   'Check if error occured.
   If Err.Number <> 0 Then

      MsgBox "3-D Rotation requires that you have a " _
         & "presentation open. Open a presentation, select " _
         & "a 3-D object and run 3-D Rotation " _
         & "again.", vbExclamation, "3-D Rotation Error"
      End

   End If

   'Make sure that only one shape is selected.
   If ActiveWindow.Selection.ShapeRange.Count > 1 Then
   MsgBox "You have too many objects selected. 3-D Rotation " _
    Chr(13) & "requires that you select one 3-D object. To " _
    Chr(13) & "rotate more than one object at a time, use the Group" _
   & Chr(13)  "command (Click Draw on the Drawing toolbar).", _

          vbExclamation, "3-D Rotation Error"
       'Stop the macro.
       End

   End If

      'Tests to see if the object selected is a three-d shape.
      If ActiveWindow.Selection.ShapeRange.ThreeD.Visible = msoTrue Then

       'Center the 3-D Rotation dialog box.
       frmRotMe.Top = ((Application.Height \ 2) - (frmRotMe.Height \ 2))
       frmRotMe.Left = ((Application.Width \ 2) - (frmRotMe.Width \ 2))

         'Display the 3-D rotation form.
         frmRotMe.Show
      Else
         not3d = True
      End If

   End If

   MsgBox "Please choose a 3D object first.", _

      vbExclamation, "No 3D Object Selected"

End Sub

'--------------------------------------------------------------
' Procedure:      Auto_Open()
' Arguments:      none
' Description:    This code is run when the Add-in is loaded. It
'                 Adds the 3-D Rotation command to the Tools
'                 menu.
'--------------------------------------------------------------

Sub Auto_Open()

   'Store an object reference to a command bar.
   Dim ToolsMenu As CommandBars

   'Holds a reference to the new command.
   Dim NewControl As CommandBarControl

   'Store the position of the control bar.
   Dim lPosition As Long

   Dim FoundFancy As Boolean

   'Counter.
   Dim x As Long

   FoundFancy = False

   'Figure out where to place the menu choice.
   Set ToolsMenu = Application.CommandBars

   'Loop through the command bars.
   For x = 1 To ToolsMenu("Tools").Controls.Count

      With ToolsMenu("Tools").Controls.Item(x)

      'Check if animation rotation is on the menu.
         If .Caption = "&3-D Rotation..." Then

            'Animation rotation was found on the menu.
            FoundFancy = True

            If .OnAction = "LaunchRot" Then
               Exit For
            Else
               .OnAction = "LaunchRot"
               Exit For
            End If

         End If

         'Place the command after the AutoClipart command.
         If .Caption = "AutoClipArt..." Then
            Position = x + 1
            Exit For
         End If

      End With

   Next x

   'If the AutoClipArt command is not on the menu, place the command
   'in the sixth position on the menu.
   If FoundFancy = False And Position = 0 Then

      Position = 6

   End If

   If FoundFancy <> True And Position <> 0 Then

      'Add the command to the menu.
      Set NewControl = ToolsMenu("Tools").Controls.Add _
         (Type:=msoControlButton, _
         Before:=Position)

      'Name the command.
      NewControl.Caption = "&3-D Rotation..."

      'Connect the command to the macro.
      NewControl.OnAction = "LaunchRot"

   End If

End Sub

'--------------------------------------------------------------
' Procedure:      Auto_Close()
' Arguments:      none
' Description:    Removes the 3-D Rotation command from the
                  Tools menu.
'--------------------------------------------------------------

Sub Auto_Close()

   'Counter.
   Dim x As Long

   'Store an object reference to a command bar.
   Dim ToolsMenu As CommandBars

   'Figure out where to place the command.
   Set ToolsMenu = Application.CommandBars

   'Loop through the command bars.
   For x = 1 To ToolsMenu("Tools").Controls.Count

      With ToolsMenu("Tools").Controls.Item(x)

         'Check if Animation Rotation is on the menu.
         If .Caption = "3-D Rotation..." Then

            'Remove the command from the menu.
            .Delete

         End If

      End With

   Next x

End Sub

HOW TO REMOVE THE ADD-IN

To conserve memory and increase the speed of PowerPoint, you can unload add-ins that you don't use frequently. When you unload an add-in, its features and commands are no longer available to PowerPoint, but the add-in remains on your computer for easy reloading. Use the following steps to unload ThreeD.ppa.

On the Tools menu, click Add-Ins.

Select the ThreeD add-in from the list of add-ins.

Click the Remove button.

Click Close.

The 3-D Rotation command is removed from the Tools menu and the ThreeD.ppa add-in is removed from memory.

REFERENCES

For more information about using the sample code in this article, please see the following article in the Microsoft Knowledge Base:

Q212536 OFF2000: How to Run Sample Code from Knowledge Base Articles

Additional query words: 9.00 ppt9 vba vbe ppt2k powerpt vba2k ppt9.0 ppt2000 program programming

Keywords : kbcode kbmacro kbprg kbdta kbdtacode kbpptvba
Version : WINDOWS:2000
Platform : WINDOWS
Issue type : kbinfo