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 collects and removes all items on the specified layer (annotations, sketch segments, blocks, sketch points and hatch). Layer itself is not removed.
Set the name of the layer in LAYER_NAME constant.
Const LAYER_NAME AsString = "MY LAYER"Dim swApp As SldWorks.SldWorks
Sub main()
Set swApp = Application.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc
Dim swLayerMgr As SldWorks.LayerMgr
Set swLayerMgr = swModel.GetLayerManager
Dim swLayer As SldWorks.layer
Set swLayer = swLayerMgr.GetLayer(LAYER_NAME)
Dim swLayerItems() AsObject
AddItems swLayer, swLayerItemsOption_Annotations, swLayerItems
AddItems swLayer, swLayerItemsOption_SketchBlockInstance, swLayerItems
AddItems swLayer, swLayerItemsOption_SketchHatch, swLayerItems
AddItems swLayer, swLayerItemsOption_SketchPoint, swLayerItems
AddItems swLayer, swLayerItemsOption_SketchSegments, swLayerItems
If swModel.Extension.MultiSelect(swLayerItems, False, Nothing) = UBound(swLayerItems) + 1 ThenIfFalse = swModel.Extension.DeleteSelection2(swDeleteSelectionOptions_e.swDelete_Absorbed) Then
Err.Raise vbError, "", "Failed to delete entities"EndIfElse
Err.Raise vbError, "", "Failed to select items on layer"EndIfEndSubSub AddItems(layer As SldWorks.layer, itemsType As swLayerItemsOption_e, ByRef layerItems() AsObject)
Dim vItems AsVariant
vItems = layer.GetItems(itemsType)
IfNot IsEmpty(vItems) ThenIf (Not layerItems) = -1 ThenReDim layerItems(UBound(vItems))
ElseReDimPreserve layerItems(UBound(layerItems) + UBound(vItems) + 1)
EndIfDim i AsIntegerFor i = 0 To UBound(vItems)
Set layerItems(UBound(layerItems) - i) = vItems(i)
NextEndIfEndSub