Microsoft KB Archive/222725

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

Article ID: 222725

Article Last Modified on 10/11/2006

-

APPLIES TO


 * Microsoft PowerPoint 2000 Standard Edition

-



This article was previously published under Q222725





SUMMARY
A PowerPoint add-in is available that allows you to rotate three-dimensional (3-D) objects in one-degree increments.

The following file is available for download from the Microsoft Download Center:

Three-d.exe

For additional information about how to download Microsoft Support files, click the following article number to view the article in the Microsoft Knowledge Base:

119591 How to Obtain Microsoft Support Files from Online Services

Microsoft scanned this file for viruses. Microsoft used the most current virus-detection software that was available on the date that the file was posted. The file is stored on security-enhanced servers that help to prevent any unauthorized changes to the file. This self-extracting file contains the following three files:
 * ThreeD.ppt
 * ThreeD.ppa
 * Readme.txt



MORE INFORMATION
Microsoft provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers 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 requirements.

NOTE: The following macro examples work only in PowerPoint. Visual Basic for Applications macros are not supported by the Microsoft PowerPoint Viewer. For additional information, click the following article number to view the article in the Microsoft Knowledge Base:

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.

CONTENTS

 * 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:
 * 1) Start PowerPoint.
 * 2) On the Tools menu, click Add-Ins.
 * 3) Click Add New.
 * 4) In the Add New PowerPoint Add-In dialog box, select the ThreeD.ppa file and then click OK.
 * 5) 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.
 * 6) 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:
 * 1) Add a drawing object to a slide.
 * 2) Select the object.
 * 3) 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:
 * 1) Select a 3-D object.
 * 2) On the Tools menu, click 3-D Rotation.
 * 3) 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.
 * 4) 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.
 * 5) 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.
 * 1) Click OK to apply the values you set.

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.
 * 1) On the Tools menu, click Add-Ins.
 * 2) Select the ThreeD add-in from the list of add-ins.
 * 3) Click the Remove button.
 * 4) Click Close.

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

