Changing Layer Names

Hi,

I am trying to automate the renaming of layers using VBA.

The Layer Name "TEXT" & Text_Hadrian" exist in the current drawing and i am trying to merge the to the "Text_Hadrian" layer name

I have tried the folllowing

Private Sub LayerStandards()
Dim MyOldLayerName As AcadLayer
Dim MyNewLayerName As AcadLayer

MyOldLayerName.Name = "TEXT"
MyNewLayerName.Name = "Text_Hadrian"

Set MyOldLayerName.Name = MyNewLayerName.Name

End Sub

Does anyone no of an example i can modify?

Cheers,

Col

If I understand you correctly, the reason is that you are trying to assign the same name property to two different objects. You cannot do that. If you want the entities on a certain layer to be on another layer, you will have to change those entities layer property and not the layer itself. IHTH

Hi Col

I have some code that I created a while back.

See if you can tweak this to your needs

If you need help, let me know

I have 2 variables, one for current layer and one for new layer

ML

Sub ChangeLayNamePrefix()

Dim lay As AcadLayer
Dim crLayNames As String
Dim nwLayNames As String

'Update Layer name prefixs
For Each lay In ThisDrawing.Layers
 If Not lay.Name = "0" Then 'Filter out Layer 0
  If Not lay.Name = "defpoints" Then 'Filter out Layer defpoints
   crLayNames = lay.Name
  'Starting from char 1 of string variable crLayNames, if string "prefix-" exists then
   If InStr(1, crLayNames, "ADT-", vbTextCompare) Then
   'In string variable crLayerName, replace "prefix-" w\ "newprefix-"
    nwLayNames = Replace(crLayNames, "ADT-", "newprefix-", , , vbTextCompare)
    lay.Name = nwLayNames
    Debug.Print "Layer " & crLayNames & " has been changed to " & nwLayNames
   End If
  End If
 End If
Next lay

Set lay = Nothing

End Sub

Col,

I had afew minutes, so I went ahead and worked it out.

Is this what you need?

ML

Sub ChangeLayName()

Dim lay As AcadLayer
Dim crLayNames As String
Dim nwLayNames As String

'Find and replace Layer name
For Each lay In ThisDrawing.Layers
 If Not lay.Name = "0" Then 'Filter out Layer 0
  If Not lay.Name = "defpoints" Then 'Filter out Layer defpoints
   crLayNames = lay.Name
  'Starting from char 1 of string variable crLayNames, if string exists then
   If InStr(1, crLayNames, "Text", vbTextCompare) Then
  'In string variable crLayerName, replace string crLayNames w\ "Text_Hadrian"
    nwLayNames = Replace(crLayNames, crLayNames, "Text_Hadrian", , , vbTextCompare)
    lay.Name = nwLayNames
    Debug.Print "Layer " & crLayNames & " has been changed to " & nwLayNames
   End If
  End If
 End If
Next lay

Set lay = Nothing

End Sub

Why not just select all on TEXT layer (using quick select) change to other layer and purge??

Yes smorales02

You could do that or you could use layer merge from express tools or Col may have a much bigger picture in mind that we don't know about

I am a firm believer in using the application first, unless it is too cumbersome or time consuming

Mark

ML,

Thank you for taking the time to write that code. I tried it but the problems is that it errors if the layer name Text_Hadrian already exsits.

I do currently use layer translator for this task but find it a bit rubbish to be honest, maybe I don’t know how to use it to its full potential!! it seems quicker to just import use layer translator, import template and then assign the layers, rather than saving a template and then going thru the same proccess of saying yes or no to updating the layers.

We have no layer standards in our office so everyone draws with different layer names, I am not the D.O. Manager so I cant force them to work to standards, although I have issued standard templates set up correctly but they are not always used plus we modify a lot of old drawings so all the old drawings still need up dated.

Also we use standard blocks from our many suppliers and they all use different layer names.

My idea was to have a button that you clicked that mimicked layer translator but without all the fuss.

I will try to adopt ML’s code to achieve this,

Thank you for the help.

col

Col

You're welcome, it was pretty easy to tweak as I already had the other code written.

As far as the layer existing part, that is also an easy resolve.

Give me like 10 minutes and I will post the fix.

ML

OK Col,

I simply had to add an

On Error Resume Next Statement into the code

see in red

Sub ChangeLayName()

Dim lay As AcadLayer
Dim crLayNames As String
Dim nwLayNames As String

'Find and replace Layer name
For Each lay In ThisDrawing.Layers
 If Not lay.Name = "0" Then 'Filter out Layer 0
  If Not lay.Name = "defpoints" Then 'Filter out Layer defpoints
   crLayNames = lay.Name
   'Starting from char 1 of string variable crLayNames, if string "Text" is found then
    If InStr(1, crLayNames, "Text", vbTextCompare) Then
   'Replace string "Text" w\ "Text_Hadrian"
    [color=red]On Error Resume Next[/color]
    nwLayNames = Replace(crLayNames, crLayNames, "Text_Hadrian", , , vbTextCompare)
    lay.Name = nwLayNames
    Debug.Print "Layer " & crLayNames & " has been changed to " & nwLayNames
   End If
  End If
 End If
Next lay

Set lay = Nothing

End Sub

I'm sorry, I did not forsee that but if you have the layer TEXT and layer Text_Hadrian co-existing in a drawing, then that error would occur.

There can only be one Text_Hadrian layer per drawing.

So, the above code takes care of that.

See where I have this line:

Debug.Print "Layer " & crLayNames & " has been changed to " & nwLayNames

If you only have a layer Text, then with the Immediate Window open, run the code, and you will get this.

Layer TEXT has been changed to Text_Hadrian

If layer Text_Hadrian already exists, you will get this

Layer Text_Hadrian has been changed to Text_Hadrian

which for all intents and purposes is fine.

If layer TEXT and Text_Hadrian both exist in the drawing, there isn't much you can do except to instruct VBA to ignore the error and go on with the code.

Anyhow,

I think the above is what you were looking for.

Let me know if you have any other questions

Take it easy Col!

ML

Col,

This may be above the scope of what you needed but let's say for example that you already have a layer Text_Hadrian in the drawing, we could instruct VBA to rename that to something like Text_Hadrian-temp.

Then the layer Text gets renamed to Text_Hadrian

The result in this case would be a layer

Text_Hadrian-temp and a layer Text_Hadrian in your drawing.

Again, like I said in the above post, we just instructed VBA to ignore the error and rename Text_Hadrian to Text_Hadrian, if it already exists in the drawing.

ML

ML,

thank you for that. My problem is that the Layer "Text_Hadrian" is my standard layer for text. So every new drawing will have that layer in it.

I supppose away around it is to change the layer name before it is inserted into the new drawing.

I will have a think but that seems the easiest solution.

Thank you very much ML.

Cheers,

Col

Ps ive never used the Immediate Window, i use the watch window now but thats it. im not even sure the purpose of the Immediate window to be honest, will have to put it on my list of things to learn for vba!

Col

ML, i must have just posted a second after you.

I'm not sure what good it would do to end up with a 2 layers, is that not just the same as i started of with but just renamed? I am trying to condense the layers into 1 layer "Text_Hadrian".

i think if i just run the code on the old drawing before i insert the objects into the new drawing, that seems the simplest?

cheers,

col

Hi Col,

You're Welcome

Nothing to learn really, just in VBA, go to View and select Immediate window.

In the case where I am using it, you can print the results to the immediate window by using debug.print

This way you can see the result without going back to the drawing after each run.

There are a few other things you can do with it as well.

Watch is good but better then that, in View, select Locals Window.

Then place your cursor at the beginning of the code.

Then, start pressing F8, I think you will really like that

Locals is priceless in VBA.

You will see your code get processed line by line.

Each variable will get filled in as they are processed.

It is very valuable to see where your code is failing.

Also, I have found it really useful to watch how VBA handles and processes loops, you can learn a lot by watching the process.

When you fully understand how the loop is working, you can then program using loops a whole lot better

You'll get there my friend!

ML

We are a work in progress. All of us!

ML,

thank for the tips, i had seen the debug.print before but was unsure how it was used. i understand now.

Oops! it was local window i meant! sorry, i really am still learning! i think it might have been yourself who tipped me to the local window a couple of weeks back, it really has helped me a lot and it is true i am starting to learn and understand the code a lot better since i was introduced to the local window.

Cheers ML,

Col

Yes sir! It was I

LOL

My friend David introduced me to The Locals Window and I could not live without it now. So many questions that I use to ask are resolved by observing the code in Locals. At the very least, you will see what line the error is failing on or what variables are not being processed.

With The Immediate Window, you can now see the results.

I have code to where I pick points and have the cords print in the Immediate Window; that's pretty cool huh?

If you are programming, using specific point data.

Anywho,

Back to your problem....

Col,

I think a good way to handle your scenario would be to insert your object; by the way, is it a template, block?

Then layer Text_Hadrian is in the drawing.

Then we check for Layer Text; If Layer Text exists,

Then, we say, for each entity (using a selection set) on layer Text,

layer.name = Text_Hadrian

Purge, layer Text

Would that do it?

ML

ML,

yeah that would be perfect. i'm pretty sure i could write that myself too!

ok, thank you very much.

I will have ago at that tomorrow.

Cheers,

Col.

PS i open my standard drawing template that consists of various size title blocks and a set qty of layers eg "Text_Hadrian, Construction_Line_Hadrian, Hatch_Hadrian"

I decided to go with that layout as we have to deal with drawings from our other software drawing packages, architect, cladders, steel workers, systems suppliers, other draughtsman in the company, who barely use layers at all! so i just wanted an easily identifiable layer name to distinguish from other. i have set my own standard in terms of the linetype scale, thicknes, weight, colour etc and i am hoping to create a nice little vba code that will standardize any drawing i have to work on.

Cheers ML, i will be able to create it from your suggestion,

Col

Hey Col,

You're welcome sir!

Once I fully understood what you needed, I was then able to think of a viable solution.

Honestly, this is precisely one of the reasons I really like helping you; that is because you want to learn and you do take initiative before coming for help.

That is a very good attribute sir!

It took me so long to learn to be like that, but once I starting taking that approach, I really began to get better AND more resourceful.

Sometimes the answer you need is a simple Google search away : )

Now, I hope that you will be able to get the answer on your own but if you need help, just holler.

I would also be interested in seeing the finished code, if you don't mind?

Thanks!

ML