Jump to content
katto01

VBA - How to delete all lines on a layer

Recommended Posts

katto01

Hello,

 

 

Q1. I am not sure how to do this. I have hundreds of lines on a layer that I need to delete. I need to do this in VBA. I do not want to use a selection. just simply delete all lines on a layer.

Q2. same question as Q1 but with a condition on color (i.e. if red delete).

 

 

Thanks

Share this post


Link to post
Share on other sites
Tyke

Hi Katto01,

 

Here's some sample code to get you going.

 

Delete all lines on layer "Layer1":

Sub DelAllOnLayer()
   
   Dim oLine As AcadLine
   Dim oLayer As AcadLayer
       
   For Each oLine In ThisDrawing.ModelSpace
       If oLine.Layer = "Layer1" Then
           oLine.Delete
       End If
       
   Next
   
   ThisDrawing.Regen acActiveViewport
   
End Sub

To delete all red lines on layer "Layer1":

Sub DelAllOnLayerColour()
   
   Dim oLine As AcadLine
   Dim oLayer As AcadLayer
       
   For Each oLine In ThisDrawing.ModelSpace
       If oLine.Layer = "Layer1" Then
           If oLine.color = acRed Then
               oLine.Delete
           End If
       End If
       
   Next
   
   ThisDrawing.Regen acActiveViewport
   
End Sub

That should get you going. If you are going to repeat this many times with lots of layers you could have a dialogue box where the layer and colour are entered and using the entered values do the deletions.

 

Ben

Share this post


Link to post
Share on other sites
katto01

Ben, Thank you for your help

 

 

In both cases the line "For Each oLine In ThisDrawing.ModelSpace" gives me the error "type mismatch". I am in AutoCAD 2011

Share this post


Link to post
Share on other sites
BIGAL

You could try a selection set method

 

Dim SS As AcadSelectionSet
Dim FilterDXFCode(0) As Integer
Dim FilterDXFVal(0) As Variant
FilterDXFCode(0) = 8
FilterDXFVal(0) = "MYLAYER"
Set SS = ThisDrawing.SelectionSets.Add("sel1")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal

Share this post


Link to post
Share on other sites
Tyke
Ben, Thank you for your help

 

 

In both cases the line "For Each oLine In ThisDrawing.ModelSpace" gives me the error "type mismatch". I am in AutoCAD 2011

 

katto01,

 

I can only go back to version 2012 on my computer, but the code works fine there.

 

Instead of copying and pasting the code into your VBA Editor try typing it all in line for line, paying particular attention to what AutoCAD offers when declaring the variable "oLine". You should see this:

b0KGg9PAG6h3vXt949sKrXN1AcAeCz4chYAQEMgfQCAhkD6AAANcXnpbwAAYK0Q6QMANATSBwBoCKQPANAQSB8AoCGQPgBAQyB9AICG+H9mLCLoJDGcmQAAAABJRU5ErkJgggA=b0KGg9PAG6h3vXt949sKrXN1AcAeCz4chYAQEMgfQCAhkD6AAANcXnpbwAAYK0Q6QMANATSBwBoCKQPANAQSB8AoCGQPgBAQyB9AICG+H9mLCLoJDGcmQAAAABJRU5ErkJgggA=attachment.php?attachmentid=60781&cid=1&stc=1

 

See if that helps.

 

Ben

Dim a line.jpg

Share this post


Link to post
Share on other sites
katto01

Thanks for the tip. I did what you suggested. That did not change the original code you posted. The problem is still in the "For Each oLine In ThisDrawing.ModelSpace" line. same error

Share this post


Link to post
Share on other sites
Tyke
Thanks for the tip. I did what you suggested. That did not change the original code you posted. The problem is still in the "For Each oLine In ThisDrawing.ModelSpace" line. same error

 

Are you drawing lines, polylines, or something else? The code will only work with lines, polylines etc will not be deleted.

Share this post


Link to post
Share on other sites
Tyke

Try using this declaration for the oLine declaration:

 

Dim oLine As Variant

But that will pick all entities on the layer.

 

I tried the code out with just polylines and arcs (no lines) on the layer and got the same error message as you did. Check the properties of the entities on the layer to see that they are lines.

 

Ben

Edited by Tyke

Share this post


Link to post
Share on other sites
RICVBA

Use SelectionSet and its powerful filtering and Erase methods

 

Sub DeleteElements()
   Dim delSset As AcadSelectionSet

   On Error Resume Next
   Set delSset = ThisDrawing.SelectionSets.Add("Deletion")
   On Error GoTo 0
   If delSset Is Nothing Then Set delSset = ThisDrawing.SelectionSets.Item("Deletion")

   Dim gpCode(0 to 2) As Integer
   Dim dataValue(0 to 2) As Variant
   gpCode(0) = 0 : dataValue(0) = "LINE" ' filter on line elements only
   gpCode(1) = 8 : dataValue(1) = "myLayerName" ' filter on given layer
   gpCode(2) = 62 : dataValue(2) = 1 ' filter on color (1 is the red color dataValue)

   With delSset
       .Clear
       .Select acSelectionSetAll, , , gpCode, dataValue
       If .Count > 0 Then .Erase
   End With
End Sub

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×