VB CAD Tips

www.vbcad.com

Move entities from layers of a specific color to another layer
 
When moving from one CAD system or version to another, drawings often need to be updated to reflect the new drawing standards.  Some CAD packages export to .dxf files, but use layers for each unique color.

This tip takes care of the following scenerio:

I have a drawing with 10 layers on it.  4 of the layers have a color of Red applied to them.  I need to create a new layer and have all of the entities on the 4 red layers changed to the new layer.  I don't necessarily know what the layer names of the 4 layers are.  There may be 6 layers, there may be 20 red layers.  Either way, I want to move everything from existing layers where the layer color is red, to a new layer named "XYZ".

First, you need to create the layer "XYZ".  Then you can run this macro.

Sub RedLayersToMyRed()
   Dim RedLayers As String
   Dim MyLayer As AcadLayer
   Dim NewRedLayer As String
   Dim RedSS As AcadSelectionSet
   Dim GrpC(0) As Integer
   Dim GrpV(0) As Variant
   Dim CadEnt As AcadEntity
   For Each MyLayer In ThisDrawing.Layers
      If MyLayer.Color = acRed Then
            If RedLayers = "" Then
                  RedLayers = MyLayer.Name
               Else
                  RedLayers = RedLayers & "," & MyLayer.Name
            End If
      End If
   Next
   Set RedSS = ThisDrawing.SelectionSets.Add("RedSS")
   GrpC(0) = 8: GrpV(0) = RedLayers
   RedSS.Select acSelectionSetAll, , , GrpC, GrpV
   NewRedLayer = "XYZ"
   For Each CadEnt In RedSS
      CadEnt.Layer = NewRedLayer
   Next
   RedSS.Delete
End Sub

Now, follow me through the macro's execution.  First, we declare variables.  Then we cycle through the Layers collection and look at each layer's color.  If the color of the layer we are looking at is red, we want to add it to a variable containing all of the red layer names.  If we have already added 1 or more layer names to the RedLayers variable, we need to place a comma in front of the layer name we are adding.  This allows the selection set to look for entities on any number of layers.  If the variable RedLayers is empty, we only add the layer name.

Next, we create a new selection set.  We filter on the layer (group code of 8) and select all entities matching our criteria.  We specify the name of the layer on which all entities in the selection set are to be moved.  In our example, the layer name is "XYZ".  If this layer does not exist, the program will bomb.

Next, we cycle through each entity in the selection set, and change the entity's layer to the new layer specified in the variable "NewRedLayer".

Last, we delete the selection set from the selection sets collection.

Happy Programming!

Back to Tips ©2000 by VB CAD  All rights reserved.         www.vbcad.com