AnsweredAssumed Answered

Insert Part to Mouse Position

Question asked by Chris Griffith on Jul 18, 2019
Latest reply on Jul 20, 2019 by Fifi Riri

Like • Show 0 Likes0
Comment • 6

I have created a macro that takes a straight cut material template such as an HSS tubing, inserts it into the assembly, and changes it to a virtual part. From there it allows you to change lengths and sizes very quickly. It works very well but when inserting the initial part it just puts it at the origin every time and changing this is the biggest request I have from my design team.

Is there a way to insert the part at the current mouse position, or even better so it functions just like inserting a part in Solidworks where you can click where you want it inserted?

Thanks in advance!

Fifi Riri Jul 18, 2019 11:54 AM

Correct Answer

Hello. Try this:

1. Copy Module to the main module.

2. Right-click the project name in the Project Explorer and click Insert > Class Module.

3. Copy Class1 to the class module.

'Module

Option Explicit
Dim TheMouse As SldWorks.Mouse
Dim obj As New Class1
Public swModelView As SldWorks.ModelView
Public swApp As SldWorks.SldWorks
Public swAssyModel As SldWorks.ModelDoc2
Public FilePath As String
Sub main()
FilePath = "C:\MyFiles\Part1.SLDPRT"
Set swApp = Application.SldWorks
Set swAssyModel = swApp.ActiveDoc
Set swModelView = swAssyModel.GetFirstModelView
Set TheMouse = swModelView.GetMouse
obj.init TheMouse
End Sub

'Class1

Option Explicit
Dim WithEvents ms As SldWorks.Mouse
Public Sub init(Mouse As Object)
Set ms = Mouse
End Sub
Private Function ms_MouseLBtnDownNotify(ByVal x As Long, ByVal y As Long, ByVal WParam As Long) As Long
Dim ModelViewTransform As SldWorks.MathTransform
Set ModelViewTransform = swModelView.Transform
Dim swMathUtil As SldWorks.MathUtility
Set swMathUtil = swApp.GetMathUtility
Dim nPt(2) As Double
nPt(0) = x
nPt(1) = y
nPt(2) = 0
Dim swPt As SldWorks.MathPoint
Set swPt = swMathUtil.CreatePoint(nPt)
Set swPt = swPt.MultiplyTransform(ModelViewTransform.Inverse)
' Debug.Print ("X: " & Round(swPt.ArrayData(0) * 1000, 2) & " Y: " & Round(swPt.ArrayData(1) * 1000, 2) & " Z: " & Round(swPt.ArrayData(2) * 1000, 2))
Dim swPartModel As SldWorks.ModelDoc2
Set swPartModel = swApp.OpenDoc6(FilePath, swDocumentTypes_e.swDocPART, swOpenDocOptions_e.swOpenDocOptions_Silent, Empty, Empty, Empty)
Dim swAssy As SldWorks.AssemblyDoc
Set swAssy = swAssyModel
Call swAssy.AddComponent(FilePath, swPt.ArrayData(0), swPt.ArrayData(1), swPt.ArrayData(2))
swApp.CloseDoc swPartModel.GetTitle
Call swAssyModel.EditRebuild3
End
End Function

See the reply in context

No one else had this question

Outcomes

Danniel Sims Jul 18, 2019 10:02 AM

Chris,

This might get you in the right direction. This is part of an excel macro I have that pulls parts up in a form and a user can select the SW file and add it to the active assembly. It places the added part at the outer XYZ coordinate of the assembly. Each newly added component gets placed further out in space.

Set part = swApp.ActiveDoc
Set swModel = swApp.ActiveDoc
Set swAssy = swModel

Pathname = swModel.GetPathName

On Error Resume Next
vBox = swAssy.GetBox(0)
X_max = vBox(0)
Y_max = vBox(4)
Z_max = vBox(5)

If Not part.GetType = 2 Then
   MsgBox "Active file is not an assembly."
   Exit Sub
Else
   If Pathname = ufBOMSeek.lbSeek.Value Then '[THIS COMES FROM USERFORM]
      MsgBox "You cannot add an assembly to itself."
      Exit Sub
   End If
End If

Set SelMgr = part.SelectionManager
Set ModelDoc = swApp.OpenDoc(ufBOMSeek.lbSeek.Value, sldType)

part.ClearSelection2 True
'Part.AddComponent ufBOMSeek.lbSeek.value, X_max, Y_max, Z_max
part.AddComponent4 ufBOMSeek.lbSeek.Value, "", X_max, Y_max, Z_max
swApp.CloseDoc Splitter(UBound(Splitter))
boolstatus = part.EditRebuild3
boolstatus = part.SetUserPreferenceToggle(198, True)
part.ViewZoomtofit2
Set part = Nothing
Set swApp = Nothing

Actions

Fifi Riri Jul 18, 2019 11:54 AM

Hello. Try this:

1. Copy Module to the main module.

2. Right-click the project name in the Project Explorer and click Insert > Class Module.

3. Copy Class1 to the class module.

'Module

Option Explicit
Dim TheMouse As SldWorks.Mouse
Dim obj As New Class1
Public swModelView As SldWorks.ModelView
Public swApp As SldWorks.SldWorks
Public swAssyModel As SldWorks.ModelDoc2
Public FilePath As String
Sub main()
FilePath = "C:\MyFiles\Part1.SLDPRT"
Set swApp = Application.SldWorks
Set swAssyModel = swApp.ActiveDoc
Set swModelView = swAssyModel.GetFirstModelView
Set TheMouse = swModelView.GetMouse
obj.init TheMouse
End Sub

'Class1

Option Explicit
Dim WithEvents ms As SldWorks.Mouse
Public Sub init(Mouse As Object)
Set ms = Mouse
End Sub
Private Function ms_MouseLBtnDownNotify(ByVal x As Long, ByVal y As Long, ByVal WParam As Long) As Long
Dim ModelViewTransform As SldWorks.MathTransform
Set ModelViewTransform = swModelView.Transform
Dim swMathUtil As SldWorks.MathUtility
Set swMathUtil = swApp.GetMathUtility
Dim nPt(2) As Double
nPt(0) = x
nPt(1) = y
nPt(2) = 0
Dim swPt As SldWorks.MathPoint
Set swPt = swMathUtil.CreatePoint(nPt)
Set swPt = swPt.MultiplyTransform(ModelViewTransform.Inverse)
' Debug.Print ("X: " & Round(swPt.ArrayData(0) * 1000, 2) & " Y: " & Round(swPt.ArrayData(1) * 1000, 2) & " Z: " & Round(swPt.ArrayData(2) * 1000, 2))
Dim swPartModel As SldWorks.ModelDoc2
Set swPartModel = swApp.OpenDoc6(FilePath, swDocumentTypes_e.swDocPART, swOpenDocOptions_e.swOpenDocOptions_Silent, Empty, Empty, Empty)
Dim swAssy As SldWorks.AssemblyDoc
Set swAssy = swAssyModel
Call swAssy.AddComponent(FilePath, swPt.ArrayData(0), swPt.ArrayData(1), swPt.ArrayData(2))
swApp.CloseDoc swPartModel.GetTitle
Call swAssyModel.EditRebuild3
End
End Function

Actions

Chris Griffith @ Fifi Riri on Jul 18, 2019 12:52 PM

This is exactly what I was looking for! Now the challenge will be to make it work with my current code but I think I can do it. I will let you know how it goes. Thank you very much!

Actions

Chris Griffith @ Fifi Riri on Jul 19, 2019 4:10 PM

What you gave me is what I asked for but I tried to make it work in my original code and just the way that it's laid out it doesn't do what I want. The problem is that I currently have it insert the part and then open a form and do some changes. What would work really well is if I could capture the coordinates of the mouse position when the macro was run. This would allow me to basically keep my code as is but instead of inserting the part using the mouse click function it would insert it at the spot the mouse is when the macro gets run. I tried to modify this code to make it do that but can't get it to grab the coordinates without an actual click happening.

Actions

Chris Griffith @ Fifi Riri on Jul 19, 2019 7:27 PM

Ok so I ended up getting this to work and it is exactly what I wanted it to do. The only issue with it is that it doesn't pick up the z coordinate so it works perfectly when you have the view perpendicular to the xy plane. When you have the view rotated then because it always puts it at z0 it puts it at what seem to be a random location. I know it's not random, it's just putting it at xy coordinates but would be a lot better if the z value could be used as well.

Actions

Fifi Riri @ Chris Griffith on Jul 20, 2019 1:35 AM

I think the problem is that the mouse move in a 2D space, so you can only estimate the depth.

if you want you can try MouseSelectNotify that will accurately give the coordinates of an element, but obviously that will only place the new part on an existing element

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 "X: " & Round(X * 1000, 2) & vbCr & "Y: " & Round(Y * 1000, 2) & vbCr & "Z: " & Round(Z * 1000, 2)
End Function

or after inserting the part, use ms_MouseMoveNotify to get the coordinate to drag it, then release it where you want. But IMO that would be the same as placing it with the previous code and then manually re-selecting it, and dragging it.

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

Actions

6 Replies

Danniel Sims Jul 18, 2019 10:02 AM
Mark Correct
Correct Answer
Chris,

This might get you in the right direction. This is part of an excel macro I have that pulls parts up in a form and a user can select the SW file and add it to the active assembly. It places the added part at the outer XYZ coordinate of the assembly. Each newly added component gets placed further out in space.

Set part = swApp.ActiveDoc
Set swModel = swApp.ActiveDoc
Set swAssy = swModel
Pathname = swModel.GetPathName
On Error Resume Next
vBox = swAssy.GetBox(0)
X_max = vBox(0)
Y_max = vBox(4)
Z_max = vBox(5)

If Not part.GetType = 2 Then
   MsgBox "Active file is not an assembly."
   Exit Sub
Else
   If Pathname = ufBOMSeek.lbSeek.Value Then '[THIS COMES FROM USERFORM]
      MsgBox "You cannot add an assembly to itself."
      Exit Sub
   End If
End If

Set SelMgr = part.SelectionManager
Set ModelDoc = swApp.OpenDoc(ufBOMSeek.lbSeek.Value, sldType)
part.ClearSelection2 True
'Part.AddComponent ufBOMSeek.lbSeek.value, X_max, Y_max, Z_max
part.AddComponent4 ufBOMSeek.lbSeek.Value, "", X_max, Y_max, Z_max
swApp.CloseDoc Splitter(UBound(Splitter))
boolstatus = part.EditRebuild3
boolstatus = part.SetUserPreferenceToggle(198, True)
part.ViewZoomtofit2
Set part = Nothing
Set swApp = Nothing
Like • Show 1 Like1
Actions
Fifi Riri Jul 18, 2019 11:54 AM
Unmark Correct
Correct Answer
Hello. Try this:
1. Copy Module to the main module.
2. Right-click the project name in the Project Explorer and click Insert > Class Module.
3. Copy Class1 to the class module.
'Module
Option Explicit
Dim TheMouse As SldWorks.Mouse
Dim obj As New Class1
Public swModelView As SldWorks.ModelView
Public swApp As SldWorks.SldWorks
Public swAssyModel As SldWorks.ModelDoc2
Public FilePath As String
Sub main()
FilePath = "C:\MyFiles\Part1.SLDPRT"
Set swApp = Application.SldWorks
Set swAssyModel = swApp.ActiveDoc
Set swModelView = swAssyModel.GetFirstModelView
Set TheMouse = swModelView.GetMouse
obj.init TheMouse
End Sub
'Class1
Option Explicit
Dim WithEvents ms As SldWorks.Mouse
Public Sub init(Mouse As Object)
Set ms = Mouse
End Sub
Private Function ms_MouseLBtnDownNotify(ByVal x As Long, ByVal y As Long, ByVal WParam As Long) As Long
Dim ModelViewTransform As SldWorks.MathTransform
Set ModelViewTransform = swModelView.Transform
Dim swMathUtil As SldWorks.MathUtility
Set swMathUtil = swApp.GetMathUtility
Dim nPt(2) As Double
nPt(0) = x
nPt(1) = y
nPt(2) = 0
Dim swPt As SldWorks.MathPoint
Set swPt = swMathUtil.CreatePoint(nPt)
Set swPt = swPt.MultiplyTransform(ModelViewTransform.Inverse)
' Debug.Print ("X: " & Round(swPt.ArrayData(0) * 1000, 2) & " Y: " & Round(swPt.ArrayData(1) * 1000, 2) & " Z: " & Round(swPt.ArrayData(2) * 1000, 2))
Dim swPartModel As SldWorks.ModelDoc2
Set swPartModel = swApp.OpenDoc6(FilePath, swDocumentTypes_e.swDocPART, swOpenDocOptions_e.swOpenDocOptions_Silent, Empty, Empty, Empty)
Dim swAssy As SldWorks.AssemblyDoc
Set swAssy = swAssyModel
Call swAssy.AddComponent(FilePath, swPt.ArrayData(0), swPt.ArrayData(1), swPt.ArrayData(2))
swApp.CloseDoc swPartModel.GetTitle
Call swAssyModel.EditRebuild3
End
End Function
Like • Show 1 Like1
Actions
- Chris Griffith @ Fifi Riri on Jul 18, 2019 12:52 PM
  Mark Correct
  Correct Answer
  This is exactly what I was looking for! Now the challenge will be to make it work with my current code but I think I can do it. I will let you know how it goes. Thank you very much!
  Like • Show 0 Likes0
  Actions
- Chris Griffith @ Fifi Riri on Jul 19, 2019 4:10 PM
  Mark Correct
  Correct Answer
  What you gave me is what I asked for but I tried to make it work in my original code and just the way that it's laid out it doesn't do what I want. The problem is that I currently have it insert the part and then open a form and do some changes. What would work really well is if I could capture the coordinates of the mouse position when the macro was run. This would allow me to basically keep my code as is but instead of inserting the part using the mouse click function it would insert it at the spot the mouse is when the macro gets run. I tried to modify this code to make it do that but can't get it to grab the coordinates without an actual click happening.
  Like • Show 0 Likes0
  Actions
- Chris Griffith @ Fifi Riri on Jul 19, 2019 7:27 PM
  Mark Correct
  Correct Answer
  Ok so I ended up getting this to work and it is exactly what I wanted it to do. The only issue with it is that it doesn't pick up the z coordinate so it works perfectly when you have the view perpendicular to the xy plane. When you have the view rotated then because it always puts it at z0 it puts it at what seem to be a random location. I know it's not random, it's just putting it at xy coordinates but would be a lot better if the z value could be used as well.
  Like • Show 0 Likes0
  Actions
  - Fifi Riri @ Chris Griffith on Jul 20, 2019 1:35 AM
    Mark Correct
    Correct Answer
    I think the problem is that the mouse move in a 2D space, so you can only estimate the depth.
    
    if you want you can try MouseSelectNotify that will accurately give the coordinates of an element, but obviously that will only place the new part on an existing element
    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 "X: " & Round(X * 1000, 2) & vbCr & "Y: " & Round(Y * 1000, 2) & vbCr & "Z: " & Round(Z * 1000, 2)
    End Function
    
    or after inserting the part, use ms_MouseMoveNotify to get the coordinate to drag it, then release it where you want. But IMO that would be the same as placing it with the previous code and then manually re-selecting it, and dragging it.
    Private Function ms_MouseMoveNotify(ByVal X As Long, ByVal Y As Long, ByVal WParam As Long) As Long
    Like • Show 0 Likes0
    Actions

Insert Part to Mouse Position

Outcomes

Related Content

Recommended Content