Remove all items from the layer in SOLIDWORKS model
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 As String = "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() As Object
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 Then
If False = swModel.Extension.DeleteSelection2(swDeleteSelectionOptions_e.swDelete_Absorbed) Then
Err.Raise vbError, "", "Failed to delete entities"
End If
Else
Err.Raise vbError, "", "Failed to select items on layer"
End If
End Sub
Sub AddItems(layer As SldWorks.layer, itemsType As swLayerItemsOption_e, ByRef layerItems() As Object)
Dim vItems As Variant
vItems = layer.GetItems(itemsType)
If Not IsEmpty(vItems) Then
If (Not layerItems) = -1 Then
ReDim layerItems(UBound(vItems))
Else
ReDim Preserve layerItems(UBound(layerItems) + UBound(vItems) + 1)
End If
Dim i As Integer
For i = 0 To UBound(vItems)
Set layerItems(UBound(layerItems) - i) = vItems(i)
Next
End If
End Sub