ModelView Rotation Macro Needed

Hi,

I would like to experiment with the following... actually keep experimenting
(I am stuck)...

Have a macro "rotate" (or move/translate) a model (part or assembly) on the
screen in the SolidWorks main view window. I have had some luck looking
this up in the API help, but there are no examples.

Think of this like the views in eDrawings cycling thru top, side, right,
iso, etc., (hit the play button) but within SolidWorks.

Thanks in advance,

Aron

 

Code pasted in below.

Macro set for SolidWorks default Hotkey setting:
Front View = <ctrl> + 1
Back View = <ctrl> + 2
Left View = <ctrl> + 3
Right View = <ctrl> + 4
Top View = <ctrl> + 5
Bottom View = <ctrl> + 6
Iso View = <ctrl> + 7

If your's is setup different, go to this section and change the
values.
'Default SW - Key-string for model views

Enjoy,
Ken

********* Code Below *********
'NOTE:
' Macro does not behave right when running from within VB.
' Call/Run macro directly from SolidWorks, otherwise the SendKeys
function sends the keys to VB.

'Started From SW API Help Example:
'Change to Isometric and Zoom to Fit View Mode Example (VB)
'This example shows how to change the current view mode to isometric
and Zoom to Fit.
'-----------------------------------------------
'
' Preconditions: Model document is open.
'
' Postconditions: Current view mode is changed.
'
'-----------------------------------------------

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2

Sub Pause(PauseTime As Double)
'VBA Example:
'Timer Function Example
'This example uses the Timer function to pause the application. The
example also uses DoEvents to yield to other processes during the
pause.

Dim Start As Double
Dim Finish As Double
Dim TotalTime As Double

Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
Finish = Timer ' Set end time.
TotalTime = Finish - Start ' Calculate total time.
'MsgBox "Paused for " & TotalTime & " seconds"

End Sub

Sub TransitionView_CommonOps()
'Zoom to extents
'swModel.ViewZoomtofit2

Pause 1
End Sub

'This Module For Reference Only...I don't like the way the views
change.
' They don't "animate" when they move.
' They need to be Zoomed to Extents.
Sub v01_main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

If (swModel Is Nothing) Then
MsgBox "No SolidWorks document open." & Chr(13) & "Routine
ending.", vbCritical, "ModelView Rotation"
End
End If


If (swModel.GetType <> swDocDRAWING) Then

'Set view
'swModel.ShowNamedView2 "*Isometric", 7
'swModel.ShowNamedView2 "*Trimetric", 8
swModel.ShowNamedView2 "*Dimetric", 9
Call TransitionView_CommonOps

swModel.ShowNamedView2 "*Front", -1
Call TransitionView_CommonOps

swModel.ShowNamedView2 "*Top", -1
Call TransitionView_CommonOps

swModel.ShowNamedView2 "*Right", -1
Call TransitionView_CommonOps

swModel.ShowNamedView2 "*Bottom", -1
Call TransitionView_CommonOps

swModel.ShowNamedView2 "*Left", -1
Call TransitionView_CommonOps

swModel.ShowNamedView2 "*Back", -1
Call TransitionView_CommonOps

End If

'Rebuild File
'swModel.EditRebuild3 'Stoplight or [Ctrl]+B
' swModel.ForceRebuild '[Ctrl]+Q

Set swModel = Nothing
Set swApp = Nothing

End Sub

Sub main()

Dim sIsoV As String
Dim sFrontV As String
Dim sBackV As String
Dim sLeftV As String
Dim sRightV As String
Dim sTopV As String
Dim sBottomV As String

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

If (swModel Is Nothing) Then
MsgBox "No SolidWorks document open." & Chr(13) & "Routine
ending.", vbCritical, "ModelView Rotation"
End
End If


If (swModel.GetType <> swDocDRAWING) Then

'Default SW - Key-string for model views
sFrontV = "^1" '<ctrl> 1
sBackV = "^2" '<ctrl> 2
sLeftV = "^3" '<ctrl> 3
sRightV = "^4" '<ctrl> 4
sTopV = "^5" '<ctrl> 5
sBottomV = "^6" '<ctrl> 6
sIsoV = "^7" '<ctrl> 7

SendKeys sIsoV
Call TransitionView_CommonOps

SendKeys sFrontV
Call TransitionView_CommonOps

SendKeys sRightV
Call TransitionView_CommonOps

SendKeys sBackV
Call TransitionView_CommonOps

SendKeys sLeftV
Call TransitionView_CommonOps

SendKeys sFrontV
Call TransitionView_CommonOps

SendKeys sTopV
Call TransitionView_CommonOps

SendKeys sFrontV
Call TransitionView_CommonOps

SendKeys sBottomV
Call TransitionView_CommonOps

SendKeys sFrontV
Call TransitionView_CommonOps

SendKeys sIsoV
Call TransitionView_CommonOps

End If

MsgBox "Done!", vbOKOnly, "ModelView Rotation"

'Rebuild File
'swModel.EditRebuild3 'Stoplight or [Ctrl]+B
' swModel.ForceRebuild '[Ctrl]+Q

Set swModel = Nothing
Set swApp = Nothing

End Sub