> Run SolidWorks Commands and Synthesize Mouse Events Example (VBA)

Run SolidWorks Commands and Synthesize Mouse Events Example (VBA)

This example shows how to run SolidWorks commands and synthesize mouse events in an application.

Form: Form1 (Form1.frm)
Module: mouse1
Class module: Class1

NOTE: For best results testing this example, the SolidWorks window should be fully maximized. This example also needs an open SolidWorks part document containing a rectangular block.

Form1

'------------------------------------------------------------------------------------

Option Explicit

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swModelDocExt As SldWorks.ModelDocExtension

Dim swModelView As SldWorks.ModelView

Dim mouse As Object

Dim TheDate As Date

Dim WithEvents TheMouse As SldWorks.mouse

Dim X, Y As Double

Dim i, j, ii As Integer

______________________________________________________________________________________

'Zoom to Area button

Private Sub Command1_Click()

Set swApp = CreateObject("SldWorks.Application")

Set swModel = swApp.ActiveDoc

Set swModelDocExt = swModel.Extension

Set swModelView = swModel.GetFirstModelView

Set TheMouse = swModelView.GetMouse

X = 0

swModelDocExt.RunCommand swCommands_Front, ""

swModelDocExt.RunCommand swCommands_ZoomToFit, ""

swModelDocExt.RunCommand swCommands_ZoomToArea, ""

TheMouse.MoveXYZ -0.0257, 0.021, 0.025, swMouse_MouseMove + swMouse_LeftDown

For i = 1 To 20

TheMouse.Move 5, 5, swMouse_MouseMove

TheMouse.MoveXYZ -2.19101587210489E-02, 1.60006957747979E-02, 2.49999999999773E-02, swMouse_MouseMove + swMouse_LeftUp

timeout 1

swModelDocExt.RunCommand swCommands_ZoomToArea, ""

timeout 1

End Sub

______________________________________________________________________________________

Sub timeout(PauseTime As Integer)

Dim Start, Finish, TotalTime

Start = Timer ' Set start time

Do While Timer < Start + PauseTime

DoEvents ' Yield to other processes

Loop

End Sub

______________________________________________________________________________________

'Rotate View button

Private Sub Command2_Click()

Set swApp = CreateObject("SldWorks.Application")

Set swModel = swApp.ActiveDoc

Set swModelDocExt = swModel.Extension

Set swModelView = swModel.GetFirstModelView

Set TheMouse = swModelView.GetMouse

j = 1

swModelDocExt.RunCommand swCommands_Front, ""

swModelDocExt.RunCommand swCommands_ZoomToFit, ""

While j <> 0

swModelDocExt.RunCommand swCommands_RotateView, ""

TheMouse.MoveXYZ -1.94809781021641E-02, 1.36614848084644E-02, 2.49999999999773E-02, swMouse_MouseMove + swMouse_LeftDown

ii = 0

For i = 1 To 40

If Check1.Value = 1 Then

ii = ii + 1

If ii = 8 Then

timeout 1

ii = 0

End If

TheMouse.Move 5, 5, swMouse_MouseMove + swMouse_LeftDown

TheMouse.Move 0, 0, swMouse_LeftUp

j = j - 1

timeout 1

swModelDocExt.RunCommand swCommands_RotateView, ""

Wend

End Sub

______________________________________________________________________________________

'Fillet button

Private Sub Command3_Click()

Set swApp = CreateObject("SldWorks.Application")

Set swModel = swApp.ActiveDoc

Set swModelDocExt = swModel.Extension

Set swModelView = swModel.GetFirstModelView

Set TheMouse = swModelView.GetMouse

swModelDocExt.RunCommand swCommands_Front, ""

swModelDocExt.RunCommand swCommands_ZoomToFit, ""

swModelDocExt.RunCommand swCommands_Fillet, "API Fillet"

timeout 1

TheMouse.MoveXYZ 0.02572736767983, -0.00820741159683, 0.02499999999998, swMouse_MouseMove + swMouse_LeftDown

TheMouse.MoveXYZ 0.02572736767983, -0.00820741159683, 0.02499999999998, swMouse_LeftUp

timeout 1

TheMouse.MoveXYZ -2.54189751705491E-02, 7.6335180875281E-03, 2.49999999998636E-02, swMouse_MouseMove + swMouse_LeftDown

TheMouse.MoveXYZ -2.54189751705491E-02, 7.6335180875281E-03, 2.49999999998636E-02, swMouse_LeftUp

timeout 1

TheMouse.MoveXYZ 4.81082808668361E-03, 1.85198460462339E-02, 2.49999999999773E-02, swMouse_MouseMove + swMouse_LeftDown

TheMouse.MoveXYZ -2.54189751705491E-02, 7.6335180875281E-03, 2.49999999998636E-02, swMouse_LeftUp

timeout 1

TheMouse.MoveXYZ 4.84461095740582E-02, 9.97272905386159E-03, 2.49999999999773E-02, swMouse_MouseMove + swMouse_LeftDown

TheMouse.MoveXYZ -2.54189751705491E-02, 7.6335180875281E-03, 2.49999999998636E-02, swMouse_LeftUp

timeout 1

swModelDocExt.RunCommand swCommands_PmOK, ""

End Sub

______________________________________________________________________________________

'Undo button

Private Sub Command4_Click()

Set swApp = CreateObject("SldWorks.Application")

Set swModel = swApp.ActiveDoc

Set swModelDocExt = swModel.Extension

Set swModelView = swModel.GetFirstModelView

Set TheMouse = swModelView.GetMouse

swModelDocExt.RunCommand swCommands_Front, ""

swModelDocExt.RunCommand swCommands_ZoomToFit, ""

swModelDocExt.RunCommand swCommands_Undo, ""

End Sub

______________________________________________________________________________________

'Exit dialog box

Private Sub Command5_Click()

End

End Sub

______________________________________________________________________________________

'Model Coordinates' Go to XYZ button

Private Sub Command6_Click()

Dim X As Double

Dim Y As Double

Dim z As Double

X = Val(Xw.Text)

Y = Val(Yw.Text)

z = Val(Zw.Text)

TheMouse.MoveXYZ X, Y, z, swMouse_MouseMove + swMouse_LeftDown

timeout 1

TheMouse.Move 0, 0, swMouse_LeftUp

End Sub

______________________________________________________________________________________

'Go to XY button

Private Sub Command7_Click()

Dim X As Integer

Dim Y As Integer

X = Val(Xs.Text)

Y = Val(Ys.Text)

TheMouse.Move X, Y, swMouse_Absolute + swMouse_MouseMove + swMouse_LeftDown

TheMouse.Move X, Y, swMouse_Absolute + swMouse_LeftUp

End Sub

______________________________________________________________________________________

'Screen Coordinates Go to XY button

Private Sub Command8_Click()

X = Val(Xg.Text)

Y = Val(Yg.Text)

TheMouse.Move X, Y, swMouse_Absolute + swMouse_MouseMove + swMouse_LeftDown

End Sub

______________________________________________________________________________________

Private Sub Form_Load()

Set swApp = CreateObject("SldWorks.Application")

Set swModel = swApp.ActiveDoc

Set swModelDocExt = swModel.Extension

Set swModelView = swModel.GetFirstModelView

Set TheMouse = swModelView.GetMouse

End Sub

______________________________________________________________________________________

Private Function TheMouse_MouseMoveNotify(ByVal X As Long, ByVal Y As Long, ByVal WParam As Long) As Long

Xs.Text = Str$(X)

Ys.Text = Str$(Y)

End Function

______________________________________________________________________________________

Private Function TheMouse_MouseSelectNotify(ByVal Ix As Long, ByVal Iy As Long, ByVal X As Double, ByVal Y As Double, ByVal z As Double) As Long

Xw.Text = Str$(X)

Yw.Text = Str$(Y)

Zw.Text = Str$(z)

Xg.Text = Str$(Ix)

Yg.Text = Str$(Iy)

End Function

______________________________________________________________________________________

Module: mouse1

'--------------------------------------------------------------------------------------

Option Explicit

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swSelMgr As SldWorks.SelectionMgr

Dim swModelDocExt As SldWorks.ModelDocExtension

Dim swModelView As SldWorks.ModelView

Dim swMouse As SldWorks.mouse

Dim TheDate As Date

Dim TheMouse As SldWorks.mouse

Dim obj As New Class1

Dim i, j As Integer

Dim X As Double

______________________________________________________________________________________

Sub main()

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Set swModelDocExt = swModel.Extension

Set swModelView = swModel.GetFirstModelView

Set TheMouse = swModelView.GetMouse

obj.init TheMouse

X = 0

swModelDocExt.RunCommand swCommands_ZoomToFit, ""

swModelDocExt.RunCommand swCommands_ZoomToArea, ""

TheMouse.Move 50, 150, swMouse_Absolute + swMouse_MouseMove + swMouse_LeftDown

For i = 1 To 20

DoEvents

TheMouse.Move 5, 5, swMouse_MouseMove

TheMouse.Move 5, 5, swMouse_LeftUp

swModelDocExt.RunCommand swCommands_ZoomToArea, ""

j = 4

While j <> 0

swModelDocExt.RunCommand swCommands_RotateView, ""

TheMouse.MoveXYZ 0.03720615681732, 0.0316583060694, 0.04991700841805, swMouse_LeftDown

For i = 1 To 20

DoEvents

TheMouse.Move 5, 5, swMouse_MouseMove

TheMouse.Move 0, 0, swMouse_LeftUp

j = j - 1

timeout 1

swModelDocExt.RunCommand swCommands_Front, ""

swModelDocExt.RunCommand swCommands_RotateView, ""

Wend

DoEvents

TheMouse.MoveXYZ 0.026048951048951, 1.63412004662006E-02, 5.00000000000114E-02, swMouse_MouseMove + swMouse_LeftDown

DoEvents

TheMouse.MoveXYZ 0.026048951048951, 1.63412004662006E-02, 5.00000000000114E-02, swMouse_MouseMove + swMouse_LeftDown

End Sub

______________________________________________________________________________________

Sub timeout(PauseTime As Integer)

Dim Start, Finish, TotalTime

Start = Timer ' Set start time

Do While Timer < Start + PauseTime

DoEvents ' Yield to other processes

Loop

End Sub

______________________________________________________________________________________

Class module: Class1

'--------------------------------------------------------------------------------------

Dim WithEvents ms As SldWorks.mouse

______________________________________________________________________________________

Private Sub Class_Initialize()

End Sub

______________________________________________________________________________________

Public Sub init(mouse As Object)

Set ms = mouse

End Sub

______________________________________________________________________________________

Private Function ms_MouseNotify(ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Debug.Print "Event Message= " & Message & " wParam= " & wParam & " lParam= "; lParam

End Function

______________________________________________________________________________________

Private Function ms_MouseSelectNotify(ByVal ix As Long, ByVal iy As Long, ByVal X As Double, ByVal Y As Double, ByVal Z As Double) As Long

Debug.Print "Mouse loc ix = " & ix & " iy = " & iy & " x= " & X; " y= " & Y; " z= " & Z

End Function

______________________________________________________________________________________

Search 'Run SolidWorks Commands and Synthesize Mouse Events Example (VBA)' in the SOLIDWORKS Knowledge Base.

Provide feedback on this topic

SOLIDWORKS welcomes your feedback concerning the presentation, accuracy, and thoroughness of the documentation. Use the form below to send your comments and suggestions about this topic directly to our documentation team. The documentation team cannot answer technical support questions. Click here for information about technical support.

* Required


*Email:
Subject:		Feedback on Help Topics
Page:		Run SolidWorks Commands and Synthesize Mouse Events Example (VBA)
*Comment:
*		I acknowledge I have read and I hereby accept the privacy policy under which my Personal Data will be used by Dassault Systèmes

Cancel

Print Topic

Select the scope of content to print:

This topic and all topics linked from this topic

Just this topic

This topic and only immediate topics under it

This selected topic and all subtopics

Cancel

We have detected you are using a browser version older than Internet Explorer 7. For optimized display, we suggest upgrading your browser to Internet Explorer 7 or newer.

Never show this message again

Web Help Content Version: API Help (English only) 2010 SP05

To disable Web help from within SOLIDWORKS and use local help instead, click Help > Use SOLIDWORKS Web Help.

To report problems encountered with the Web help interface and search, contact your local support representative. To provide feedback on individual help topics, use the “Feedback on this topic” link on the individual topic page.