How to translate selected parts in Assembly

[SulzHelp]

Hello all,

Here are few days that I'm working on a macro which still doesn't work.
I'm trying to translate (according axes) parts in an assembly. I still don't know which API command I need to use.

I found something on the API Help but it doesn't work correctly. I've remastered it a little bit, here it is.

Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim swSelMgr As SldWorks.SelectionMgr
Dim swComp As SldWorks.Component2
Dim vXform As Variant
Dim arr(15) As Double
Dim swMathUtil As SldWorks.MathUtility
Dim swMathXform As SldWorks.MathTransform
Dim swModelView As SldWorks.ModelView
Dim i As Long
Dim rect As Variant
Dim lErrors As Long
Dim lWarnings As Long
Dim TranslateValue As Double

Set swApp = Application.SldWorks
Set swMathUtil = swApp.GetMathUtility()
Set swModel = swApp.ActiveDoc
Set swAssy = swModel
Set swSelMgr = swModel.SelectionManager
Set swComp = swSelMgr.GetSelectedObjectsComponent4(1, -1)

TranslateValue = 0.015

swAssy.EnablePresentation = True

arr(0) = 1#: arr(1) = 0#: arr(2) = 0#
arr(3) = 0#: arr(4) = 1#: arr(5) = 0#
arr(6) = 0#: arr(7) = 0#: arr(8) = 1#
arr(9) = 0#: arr(10) = 0#: arr(11) = 0#
arr(12) = 1#
arr(13) = 0#: arr(14) = 0#: arr(15) = 0#

' Change translation
arr(9) = 0: arr(10) = TranslateValue: arr(11) = 0#

vXform = arr
Set swMathXform = swMathUtil.CreateTransform((vXform))

swComp.RemovePresentationTransform
swComp.PresentationTransform = swMathXform

' Redraw so it is shown immediately
Set swModelView = swModel.ActiveView
Set rect = Nothing
swModelView.GraphicsRedraw (rect)

' Re-enable access to menus
swAssy.EnablePresentation = False

boolstatus = swModel.Save3(swSaveAsOptions_Silent, lErrors, lWarnings)
swApp.CloseDoc (swModel.GetTitle)

End Sub

At this point, the component is correctly moving. That's cool . But the move is made during while EnablePresentation is true. As soon as I switch it to false, the component go back to his initial place don't know why..
I've also tried to save and close the Assembly without switching it to false, but at the opening, parts are still located to their initial places.

I would be really grateful if someone could help me (with this method or by giving me another one). I also tried with InsertMoveCopyBody2 but I think this API command concern bodies in part files...

Best Regards,
SulzHelp

[gupta9665]

Check following link to give you some ideas

https://stackoverflow.com/questions/671 ... embly-axis
https://cadbooster.com/complete-overvie ... sformation

[SulzHelp]

Hello gupta9665,

Thanks a lot for your help. I've been searching all this day but I've finally found thanks to the links you sent.
For anyone who's looking to make something similar, here is the code...

Option Explicit
Sub TranslateY(DeplacementValue As String)

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swMath As SldWorks.MathUtility
Dim swComp As SldWorks.Component2
Dim vData As Variant

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swComp = swSelMgr.GetSelectedObjectsComponent2(1)

'==============================
On Error Resume Next
'==============================

Dim swXfms As SldWorks.MathTransform

Debug.Print swComp.Name

Set swXfms = swComp.Transform2
Set swMath = swApp.GetMathUtility

Dim dXfm(0 To 15) As Double
Dim vXfmCurrent As Variant
vXfmCurrent = swXfms.ArrayData

Debug.Print " Component = " & swComp.Name2 & " [" & swComp.GetPathName & "]"
Debug.Print " Actual position in translation of the component = (" & vXfmCurrent(9) * 1000# & ", " & vXfmCurrent(10) * 1000# & ", " & vXfmCurrent(11) * 1000# & ") mm"

vXfmCurrent(9) = 0: vXfmCurrent(10) = DeplacementValue: vXfmCurrent(11) = 0

vData = vXfmCurrent

Set swXfms = swMath.CreateTransform(vData)
swComp.Transform2 = swXfms

swModel.EditRebuild

End Sub


Thanks again !