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
Chad Ehret
Posted (edited)

The reason you were getting a "type mismatch" error in the For Each loop is that the collection you're looping through (ThisDrawing.ModelSpace) contains more entity types than just AcadLine objects.  You'll need to modify your loop to handle any type of entity, check to see if it's a line, and then delete it if it's a line.  Code will probably look something like this:


 

Sub DeleteAllLinesOnLayer(ByVal TargetLayer as String)
	Dim oEntity as AcadEntity

	For Each oEntity In ThisDrawing.ModelSpace
		If oEntity.Layer = TargetLayer And TypeOf oEntity is AcadLine Then
			oEntity.Delete
			ThisDrawing.Regen
		End If
	Next
End Sub

Note:  The "ThisDrawing.Regen" is there just to force the drawing to be updated so you can see each line being deleted.  Of course, all of the other entities on the layer (such as text, arcs, etc.) will be left behind.

Edited by Chad Ehret

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...