AnsweredAssumed Answered

Looking for a Macro to delete all items on a layer in drawing

Question asked by Robert Conklin on Dec 11, 2020
Latest reply on Dec 18, 2020 by Robert Conklin

Like • Show 0 Likes0
Comment • 4

I have 100 drawings and am looking for a Macro to delete all items on a selected layer in drawing.

If I can get the bit of code to find a "NAMED" Layer and delete every thing on it,

OR better yet to select everything in a given window or area on a given layer in a drawing & delete.

I think I can make it look at all sheets in a drawing and all drawings in a subdirectory and do likewise.

but if that was part of an existing macro that would be Great.

I think just deleting a layer makes the items on that layer then have a layer prop of --none-- ?

Artem Taturevych Dec 17, 2020 5:54 PM

Correct Answer

Check this macro: Remove all items from the layer in SOLIDWORKS model

See the reply in context

No one else had this question

Outcomes

4 Replies

Omkar Deshpande Dec 15, 2020 7:58 AM
Mark Correct
Correct Answer
try this. this is only for sketch segments in a layer. You can do the same for other layer items (e.g. blocks, annotations etc)

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swSelData As SldWorks.SelectData
Dim swLayerMgr As SldWorks.LayerMgr
Dim LayerList() As String
Dim swLayer As SldWorks.Layer
Dim LayerItemSegList As Variant
Dim swSeg As SldWorks.SketchSegment

Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swSelData = swSelMgr.CreateSelectData
Set swLayerMgr = swModel.GetLayerManager
LayerList = swLayerMgr.GetLayerList
Dim L As Integer
For L = 0 To UBound(LayerList)
If LayerList(L) = "FORMAT" Or LayerList(L) = "HIDE" Then
Else
Set swLayer = swLayerMgr.GetLayer(LayerList(L))
LayerItemSegList = swLayer.GetItems(swLayerItemsOption_e.swLayerItemsOption_SketchSegments)
Dim S As Integer
For S = 0 To UBound(LayerItemSegList)
Set swSeg = LayerItemSegList(S)
swSeg.Select2 True, -1
Next
swModel.EditDelete
swModel.EditRebuild3
End If
Next
End Sub
Like • Show 0 Likes0
Actions
Robert Conklin Dec 17, 2020 4:25 PM
Mark Correct
Correct Answer
OK so I have pieced together the following..
BUT the bit after the ************************ line
does not delete line segments as it should

Option Explicit
' Name of layer from which to delete ITEMS
Const DeleteLayer As String = "BOM"
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swDraw As SldWorks.DrawingDoc
Dim swSelMgr As SldWorks.SelectionMgr
Dim swView As SldWorks.View
Dim swAnn As SldWorks.Annotation
Dim swSelData As SldWorks.SelectData
Dim swSeg As SldWorks.SketchSegment
Dim swLayer As SldWorks.Layer
Dim swLayerMgr As SldWorks.LayerMgr
Dim LayerItemSegList As Variant
Dim LayerList() As String
Dim NumShts As Long
Dim bRet As Boolean
Dim i As Long
Dim j As Long
Dim R As Integer

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swDraw = swModel
Set swSelMgr = swModel.SelectionManager
Set swSelData = swSelMgr.CreateSelectData

NumShts = swDraw.GetSheetCount
For i = 1 To NumShts
swDraw.SheetPrevious
Next i

For i = 1 To NumShts
' Clear the selection set for the sheet
swModel.ClearSelection2 True

Set swView = swDraw.GetFirstView
While Not swView Is Nothing
Set swAnn = swView.GetFirstAnnotation3
While Not swAnn Is Nothing
' If the annotation is a note, then determine
' if the layer is "DeleteLayer"
If swNote = swAnn.GetType Then
If DeleteLayer = swAnn.Layer Then
' If the layer is the "DeleteLayer" layer
' then select the notes residing
' on that layer
bRet = swAnn.Select3(True, swSelData)
End If
End If

Set swAnn = swAnn.GetNext3
Wend

Set swView = swView.GetNextView
Wend

' Delete the selected notes on the DEL ME layer
bRet = swModelDocExt.DeleteSelection2(swDelete_Absorbed)

swDraw.SheetNext
Next i
'********************************************************************************************
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swSelData = swSelMgr.CreateSelectData
Set swLayerMgr = swModel.GetLayerManager
LayerList = swLayerMgr.GetLayerList
Dim L As Integer
For L = 0 To UBound(LayerList)
For R = 0 To 50
If LayerList(L) = DeleteLayer Then
Set swLayer = swLayerMgr.GetLayer(LayerList(L))
LayerItemSegList = swLayer.GetItems(swLayerItemsOption_e.swLayerItemsOption_SketchSegments)

Dim S As Integer
For S = 0 To 1
Set swSeg = LayerItemSegList(0)
swSeg.Select2 True, -1
Next
swModel.EditDelete
swModel.EditRebuild3
Else
End If
Next
Next
End Sub
Attachments
- DeleteAllNotes&SegmentsOnSpecfiedLayer.swp.zip12.9 KB
Like • Show 0 Likes0
Actions
- Artem Taturevych @ Robert Conklin on Dec 17, 2020 5:54 PM
  Unmark Correct
  Correct Answer
  Check this macro: Remove all items from the layer in SOLIDWORKS model
  Like • Show 4 Likes4
  Actions
  - Robert Conklin @ Artem Taturevych on Dec 18, 2020 10:43 AM
    Mark Correct
    Correct Answer
    Artem Taturevich Thanks The macro at the link you posted works GREAT!
    Thanks
    Like • Show 0 Likes0
    Actions

Looking for a Macro to delete all items on a layer in drawing

Outcomes

Attachments

Related Content

Recommended Content