Hide Table of Contents

Run SolidWorks Commands and Synthesize Mouse Events Example (VBA)

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

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

    Next

    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

            End If

          TheMouse.Move 5, 5, swMouse_MouseMove + swMouse_LeftDown

        Next

          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

______________________________________________________________________________________

 

Back to top

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

    Next

   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

        Next

            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

______________________________________________________________________________________

 

Back to top

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

______________________________________________________________________________________

 

Back to top



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

Print Topic

Select the scope of content to print:



x

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
x

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.