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.
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.
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
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