PPT97: Add-in Rotates 3-D Objects in One-degree IncrementsLast reviewed: March 9, 1998Article ID: Q164515 |
The information in this article applies to:
SUMMARYAn 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 (size: 75852 bytes) 75 KB self-extracting fileThis self-extracting file contains the following three files:
ThreeD.ppt ThreeD.ppa Readme.txtFor more information about downloading files from the Microsoft Software Library, please see the following article in the Microsoft Knowledge Base:
ARTICLE-ID: Q119591 TITLE : How to Obtain Microsoft Support Files from Online Services MORE INFORMATIONMicrosoft 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 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 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/refguide/default.asp Contents of the Readme.txt fileThe following information is the complete text of the Readme.txt file:
HOW TO USE THIS DOCUMENTTo 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?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-INTo 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:
HOW TO USE THREED.PPABy 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:
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 IfEnd 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 WithEnd Function
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 = "A&utoClipArt..." 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-INTo 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.
REFERENCESFor more information about getting help with Visual Basic for Applications, please see the following article in the Microsoft Knowledge Base:
ARTICLE-ID: Q163435 TITLE : VBA: Programming Resources for Visual Basic for Applications |
Additional query words: 97 kbpptvba ppa add in add-in
© 1998 Microsoft Corporation. All rights reserved. Terms of Use. |