Anonymous
354 Views, 0 Replies
03-17-2018
01:59 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
03-17-2018
01:59 PM
Turntable View Rotation
I have created a turntable VBA macro that works in most cases but is a bit buggy depending on the initial view.
The rotation is about the Z axis and the issues occur when looking directly up or down the axis (Top or Bottom view)
The fault is the view jumps to a new position, the rotation starts doesn't compete 360 deg, then model disappears until clicking in the graphics window.
I could fix it by setting the view to home before rotating but would prefer to use any view if possible to make it more flexible.
Any suggestions how to improve it would be appreciated. ![]()
Public Sub Turntable()
' Define Pi.
Dim pi As Double
pi = Math.Atn(1) * 4
'Rotation speed in Rad/Sec
Dim rotSpeedRad As Double
rotSpeedRad = 30 * pi / 180
'Define & check current document type
Dim oDoc As Document
Set oDoc = ThisApplication.ActiveDocument
If oDoc.DocumentType = kDrawingDocumentObject Then GoTo Finished
'Get center point of the model
Dim centerPoint As Point
Dim minPoint As Point
Set minPoint = oDoc.ComponentDefinition.RangeBox.minPoint
Dim maxPoint As Point
Set maxPoint = oDoc.ComponentDefinition.RangeBox.maxPoint
Set centerPoint = ThisApplication.TransientGeometry.CreatePoint( (minPoint.X + maxPoint.X) * 0.5, (minPoint.Y + maxPoint.Y) * 0.5, (minPoint.Z + maxPoint.Z) * 0.5)
'Camera and tuntable rotation
Dim camera As Inventor.camera
Set camera = ThisApplication.ActiveView.camera
Dim totalRot As Double
totalRot = 0
'Define rotation increment and axis
Dim offsetRad As Double
Dim rotAxis As Vector
Set rotAxis = ThisApplication.TransientGeometry.CreateVector(0, 0, 1)
'Rotate view
Dim upVector As UnitVector
Set upVector = ThisApplication.TransientGeometry.CreateUnitVector(0, 0, 1)
Do While (totalRot < 2 * pi)
offsetRad = 0.05 * rotSpeedRad
RotateCam camera, offsetRad, rotAxis, centerPoint, upVector
totalRot = totalRot + offsetRad
Loop
Finished:
End Sub
Public Sub RotateCam(camera As camera, ByVal offsetRad As Double,
rotAxis As Vector, centerPoint As Point, upVector As UnitVector)
Dim matrix As matrix
Set matrix = ThisApplication.TransientGeometry.CreateMatrix
Call matrix.SetToRotation(offsetRad, rotAxis, centerPoint)
Dim newEye As Point
Set newEye = camera.Eye
Call newEye.TransformBy(matrix)
camera.Eye = newEye
camera.upVector = upVector
Call camera.ApplyWithoutTransition
End SubIt is based on code from here: