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
This VBA macro deletes all features which are below the rollback bar.
Dim swApp As SldWorks.SldWorks
Sub main()
try_:
OnErrorGoTo catch_
Set swApp = Application.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc
Dim vRolledBackFeats AsVariant
vRolledBackFeats = GetRolledBackFeatures(swModel)
IfFalse = swModel.FeatureManager.EditRollback(swMoveRollbackBarTo_e.swMoveRollbackBarToEnd, "") Then
Err.Raise vbError, "", "Failed to roll forward"EndIfIf swModel.Extension.MultiSelect2(vRolledBackFeats, False, Nothing) <> UBound(vRolledBackFeats) + 1 Then
Err.Raise vbError, "", "Failed to select features"EndIfIfFalse = swModel.Extension.DeleteSelection2(swDeleteSelectionOptions_e.swDelete_Absorbed) Then
Err.Raise vbError, "", "Failed to delete features"EndIfGoTo finally_
catch_:
swApp.SendMsgToUser2 Err.Description, swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
finally_:
EndSubFunction GetRolledBackFeatures(model As SldWorks.ModelDoc2) AsVariantDim isInit AsBooleanDim swFeats() As SldWorks.Feature
Dim swFeat As SldWorks.Feature
Set swFeat = model.FirstFeature
WhileNot swFeat IsNothingIfFalse <> swFeat.IsRolledBack() ThenIfNot isInit Then
isInit = TrueReDim swFeats(0)
ElseReDimPreserve swFeats(UBound(swFeats) + 1)
EndIfSet swFeats(UBound(swFeats)) = swFeat
EndIfSet swFeat = swFeat.GetNextFeature
Wend
If isInit Then
GetRolledBackFeatures = swFeats
Else
GetRolledBackFeatures = Empty
EndIfEndFunction
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