This website uses cookies to ensure you get the best experience on our website. By using our website you agree on the following Cookie Policy, Privacy Policy, and Terms Of Use
Const TRANSITION_TIME AsDouble = 0.5
Const PAUSE_TIME AsDouble = 2
Dim swApp As SldWorks.SldWorks
Sub main()
Set swApp = Application.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc
IfNot swModel IsNothingThenIf swModel.GetPathName() <> ""ThenDim vConfs AsVariant
vConfs = GetSelectedConfigurations(swModel)
IfNot IsEmpty(vConfs) ThenDim swAssy As SldWorks.AssemblyDoc
Set swAssy = NewAssembly
IfNot swAssy IsNothingThenDim vComps AsVariant
vComps = CreateComponents(swAssy, swModel, vConfs)
Dim swMotionStudyMgr AsObjectSet swMotionStudyMgr = swAssy.Extension.GetMotionStudyManager()
Dim swMotionStudy AsObjectSet swMotionStudy = swMotionStudyMgr.CreateMotionStudy()
CreateFrames swMotionStudy, vComps, TRANSITION_TIME, PAUSE_TIME
Else
MsgBox "Failed to create new assembly"EndIfElse
MsgBox "Please select configurations"EndIfElse
MsgBox "Please save document"EndIfElse
MsgBox "Please open part or assembly"EndIfEndSubSub CreateFrames(motionStudy AsObject, vComps AsVariant, transitionTime AsDouble, pauseTime AsDouble)
Dim i AsIntegerDim swCompToHide As SldWorks.Component2
Dim swCompToShow As SldWorks.Component2
motionStudy.SetTime 0
Set swCompToShow = vComps(0)
swCompToShow.Visible = TrueFor i = 1 To UBound(vComps)
Set swCompToHide = vComps(i)
swCompToHide.Visible = FalseNextDim curTime AsDouble
curTime = 0
For i = 1 To UBound(vComps)
Set swCompToHide = vComps(i - 1)
Set swCompToShow = vComps(i)
motionStudy.SetTime curTime + transitionTime
swCompToHide.Visible = False
motionStudy.SetTime curTime + transitionTime
swCompToShow.Visible = True
curTime = i * showTime + i * pauseTime
motionStudy.SetTime curTime
swCompToShow.Visible = False
swCompToShow.Visible = TrueIf i <> UBound(vComps) ThenDim swCompToLock As SldWorks.Component2
Set swCompToLock = vComps(i + 1)
swCompToLock.Visible = True
swCompToLock.Visible = FalseEndIfNextEndSubFunction CreateComponents(assy As SldWorks.AssemblyDoc, model As SldWorks.ModelDoc2, confs AsVariant) AsVariantDim i AsIntegerDim swComps() As SldWorks.Component2
ReDim swComps(UBound(confs))
Dim dMatrix(15) AsDouble
dMatrix(0) = 1: dMatrix(1) = 0: dMatrix(2) = 0: dMatrix(3) = 0
dMatrix(4) = 1: dMatrix(5) = 0: dMatrix(6) = 0: dMatrix(7) = 0
dMatrix(8) = 1: dMatrix(9) = 0: dMatrix(10) = 0: dMatrix(11) = 0
dMatrix(12) = 1: dMatrix(13) = 0: dMatrix(14) = 0: dMatrix(15) = 0
Dim swMathUtils As SldWorks.MathUtility
Set swMathUtils = swApp.GetMathUtility
Dim swTransform As SldWorks.MathTransform
Set swTransform = swMathUtils.CreateTransform(dMatrix)
For i = 0 To UBound(confs)
Dim swComp As SldWorks.Component2
Set swComp = assy.AddComponent5(model.GetPathName(), swAddComponentConfigOptions_e.swAddComponentConfigOptions_CurrentSelectedConfig, "", True, confs(i), 0, 0, 0)
swComp.Select4 False, Nothing, False
assy.UnfixComponent
swComp.Transform2 = swTransform
swComp.ReferencedConfiguration = confs(i)
swComp.Select4 False, Nothing, False
assy.FixComponent
Set swComps(i) = swComp
Next
CreateComponents = swComps
EndFunctionFunction NewAssembly() As SldWorks.AssemblyDoc
Dim swAssy As SldWorks.AssemblyDoc
Dim assyTemplate AsString
assyTemplate = swApp.GetUserPreferenceStringValue(swUserPreferenceStringValue_e.swDefaultTemplateAssembly)
If assyTemplate <> ""ThenSet swAssy = swApp.NewDocument(assyTemplate, 0, 0, 0)
Else
Err.Raise vbObjectError, , "Assembly default template is not specified"EndIfSet NewAssembly = swAssy
EndFunctionFunction GetSelectedConfigurations(model As SldWorks.ModelDoc2) AsVariantDim confNames() AsStringDim isInit AsBooleanDim swSelMgr As SldWorks.SelectionMgr
Set swSelMgr = model.SelectionManager
Dim i AsIntegerFor i = 1 To swSelMgr.GetSelectedObjectCount2(-1)
Dim swConf As SldWorks.Configuration
OnErrorResumeNextSet swConf = swSelMgr.GetSelectedObject6(i, -1)
IfNot swConf IsNothingThenIfTrue = isInit ThenReDimPreserve confNames(UBound(confNames) + 1)
Else
isInit = TrueReDim confNames(0)
EndIf
confNames(UBound(confNames)) = swConf.Name
EndIfNext
GetSelectedConfigurations = confNames
EndFunction
Notifications
Join session by SOLIDWORKS and PDM API expret Artem Taturevych at 3DEXPERIENCE World 2025 on Feb 26 at 08:30 AM CST to explore 10 essential macros for automating drawings, assemblies, custom properties, and more