Would you like to add information to this article?
Interested in writing or submitting an article?
Have a question about this article?
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
Have you reviewed the related Knowledge Base areas below?
KnowledgeBase: Knowledge Base
KnowledgeBase: Computerization
KnowledgeBase: Computerization: CAD Computer Related Design
Would you like to add information to this article? ...
Click Here
If you have a question regarding a Knowledge Base article, your best chance at uncovering an answer is to search the entire Knowledge Base for related articles or to post your question at the appropriate WOODWEB Forum. Before posting your message, be sure to review our Forum Guidelines.
Questions entered in the Knowledge Base Article comment form will not generate responses! A list of WOODWEB Forums can be found at WOODWEB's Site Map.
When you post your question at the Forum, be sure to include references to the Knowledge Base article that inspired your question. The more information you provide with your question, the better your chances are of receiving responses.
Return to beginning of article.
|
