Assigning Layers to Line Types in CAD

Useful sample code for automatically grouping lines into particular layers by line type. October 3, 2007

Question
Is there a way to assign a line type or function to a layer so that whenever the line or function is selected, it is automatically added to a specific layer, even if another layer is selected? For example, I'd like to assign construction (xline) to a construction line layer, or all dimensions to a dimension layer, etc.

Forum Responses
(CAD Forum)
From contributor J:
Iím not sure what you are asking, but if you have express tools loaded, you can isolate the layers that you want to change and select a new layer from the layer list.



From contributor P:
If you are using full blown AutoCAD, you can make an icon and put these macros in to start these commands:

1. Vertical Construction line: {^C^C-layer;make;A_nplt;*^C^C_xline;v;\}
2. Horizontal Construction line: {^C^C-layer;make;A_nplt;*^C^C_xline;h;\}

The part inside of the brackets is the macro. Change the "A_nplt" layer to whatever your layer name is. The macro basically says: escape, escape, make the layer A_nplt if it doesn't exist; escape, escape, make horizontal xlines until I tell you to quit. The * says to keep going with the command until escape is hit. This is a good command for dimensions and notes as well, to put them on their proper layers.



From contributor H:
You can create your own buttons with commands to switch to the layer you want and draw the type of line you need. There are tutorials at the AUGI website which will help you do this.


From contributor T:
We follow the same procedure as contributor P stated. It works great.


From contributor C:
I got this from Dave over at Milllister and he said this would be cool to share. Enjoy!

Public Sub FixAllEntities()
'To run this from a button, create a new button in acad and add this to the maco box
'^C^C_-vbarun;FixAllEntities;
Dim Ent As AcadEntity
Dim MyLine As AcadLine
Dim MyCircle As AcadCircle
Dim MyConstructionLine As AcadXline
Dim MyRay As AcadRay
Dim MyEllipse As AcadEllipse
For Each Ent In ThisDrawing.ModelSpace
If Ent.ObjectName = "AcDbLine" Then
Set MyLine = Ent
ThisDrawing.Layers.Add ("layernameforline")
MyLine.Layer = "layernameforline"
MyLine.Color = acCyan
MyLine.LinetypeScale = 2
MyLine.Update
End If
If Ent.ObjectName = "AcDbCircle" Then
Set MyCircle = Ent
ThisDrawing.Layers.Add ("layernameforcircle")
MyCircle.Layer = "layernameforcircle"
MyCircle.Color = acRed
MyCircle.LinetypeScale = 3
MyCircle.Update
End If


Next
End Sub
Public Sub FixSelectedEntities()
'To run this from a button, create a new button in acad and add this to the maco box
'^C^C_-vbarun;FixSelectedEntities;
Dim MyCurrentSelectionSet As AcadSelectionSet
Dim i As Integer
'check to see if the selection set already exists.
'If it does we need to delete it as ACAD will throw an error
For i = 0 To ThisDrawing.SelectionSets.Count - 1
If ThisDrawing.SelectionSets.Item(i).Name = "MySelectionSet" Then
ThisDrawing.SelectionSets.Item(i).Delete
Exit For
End If
Next i
Set MyCurrentSelectionSet = ThisDrawing.SelectionSets.Add("MySelectionSet")
MyCurrentSelectionSet.Select acSelectionSetPrevious
For Each Ent In MyCurrentSelectionSet
If Ent.ObjectName = "AcDbLine" Then
Set MyLine = Ent
ThisDrawing.Layers.Add ("layernameforline")
MyLine.Layer = "layernameforline"
MyLine.Color = acCyan
MyLine.LinetypeScale = 2
MyLine.Update
End If
If Ent.ObjectName = "AcDbCircle" Then
Set MyCircle = Ent
ThisDrawing.Layers.Add ("layernameforcircle")

MyCircle.Layer = "layernameforcircle"
MyCircle.Color = acRed
MyCircle.LinetypeScale = 3
MyCircle.Update
End If
Next
End Sub


From the original questioner:
Yeah, Dave provided me with the following code - same but different. I'm sure that after I spend some time playing around with it, I'll be able to create more on my own. Just need to find the time.

Public Sub FixAllEntities()
'To run this from a button, create a new button in acad and add this to the maco box
'^C^C_-vbarun;FixAllEntities;
Dim Ent As AcadEntity
Dim MyLine As AcadLine
Dim MyCircle As AcadCircle
Dim MyConstructionLine As AcadXline
Dim MyRay As AcadRay
Dim MyEllipse As AcadEllipse
Dim MyLayer As AcadLayer
For Each Ent In ThisDrawing.ModelSpace
If Ent.ObjectName = "AcDbLine" Then
MyLayer = Ent.Layer
If MyLayer.Lock = True Then
MyLayer.Lock = False
Set MyLine = Ent
ThisDrawing.Layers.Add ("layernameforline")
MyLine.Layer = "layernameforline"
MyLine.color = acCyan
MyLine.LinetypeScale = 2
MyLine.Update
MyLayer.Lock = True
Else
Set MyLine = Ent
ThisDrawing.Layers.Add ("layernameforline")
MyLine.Layer = "layernameforline"
MyLine.color = acCyan
MyLine.LinetypeScale = 2
MyLine.Update
End If
End If
If Ent.ObjectName = "AcDbCircle" Then
Set MyCircle = Ent
ThisDrawing.Layers.Add ("layernameforcircle")
MyCircle.Layer = "layernameforcircle"
MyCircle.color = acRed
MyCircle.LinetypeScale = 3
MyCircle.Update
End If
If Ent.ObjectName = "AcDbXline" Then
Set MyConstructionLine = Ent
ThisDrawing.Layers.Add ("somelayername")
MyConstructionLine.Layer = "somelayername"
MyConstructionLine.color = 14
MyConstructionLine.LinetypeScale = 4
MyConstructionLine.Update
End If
Next
End Sub
Public Sub FixSelectedEntities()
'To run this from a button, create a new button in acad and add this to the maco box
'^C^C_-vbarun;FixSelectedEntities;
Dim MyCurrentSelectionSet As AcadSelectionSet
Dim i As Integer
Dim Ent As AcadEntity
Dim MyLine As AcadLine
Dim MyCircle As AcadCircle
Dim MyConstructionLine As AcadXline
Dim MyRay As AcadRay
Dim MyEllipse As AcadEllipse
'check to see if the selection set already exists.
'If it does we need to delete it as ACAD will throw an error
For i = 0 To ThisDrawing.SelectionSets.Count - 1
If ThisDrawing.SelectionSets.Item(i).Name = "MySelectionSet" Then
ThisDrawing.SelectionSets.Item(i).Delete
Exit For
End If
Next i
Set MyCurrentSelectionSet = ThisDrawing.SelectionSets.Add("MySelectionSet")
MyCurrentSelectionSet.Select acSelectionSetPrevious
For Each Ent In MyCurrentSelectionSet
If Ent.ObjectName = "AcDbLine" Then
Set MyLine = Ent
ThisDrawing.Layers.Add ("layernameforline")
MyLine.Layer = "layernameforline"
MyLine.color = acCyan
MyLine.LinetypeScale = 2
MyLine.Update
End If
If Ent.ObjectName = "AcDbCircle" Then
Set MyCircle = Ent
ThisDrawing.Layers.Add ("layernameforcircle")
MyCircle.Layer = "layernameforcircle"
MyCircle.color = acRed
MyCircle.LinetypeScale = 3
MyCircle.Update
End If
Next
End Sub