Copying text to different layer at same coordinates

Copying text to different layer at same coordinates

aaron.wrightCPM6Y
Contributor Contributor
924 Views
4 Replies
Message 1 of 5

Copying text to different layer at same coordinates

aaron.wrightCPM6Y
Contributor
Contributor

Hi.

 

As of right now, part of my code is looping through all text elements in my drawing, checking if that texts exists as a key in a dictionary, and if so, replacing with the value.

 

However, I would instead like to add the new text to a different layer - rather than just overwriting existing text.

 

So I might have a first layer and a second layer. I want to:

 

1. scan all text in the first layer

2. check if it exists in dictionary

3. if so, replace with dictionary value and copy over to second layer at the same coordinates

4. if it doesn't exist in dictionary, just add the existing text to second layer

 

Just wondering if this is even possible. I'm new to VBA in AutoCAD and struggling to find anything on this.

 

Example of part of my code below:

 

For Each ent In ThisDrawing.ModelSpace
  If TypeOf ent Is AcadText Then
    Set AText = ent
    If translator_dict.Exists(LCase(AText.TextString)) Then
      AText.TextString = translator_dict(LCase(AText.TextString))
    End If
  End If
Next ent

 

 

0 Likes
Accepted solutions (1)
925 Views
4 Replies
Replies (4)
Message 2 of 5

seabrahenrique
Advocate
Advocate
Accepted solution

Hi aaron!

 

To scan all texts in certain layer, u have to substitute the instruction "for each ent in thisdrawing.modelspace" to something like "for each ent in SS" being SS a "SelectionSet" object type that u put all objects in a layer (for example, u also can put objects by type).

 

I guess this code can help u:

 

 

Sub test()

Dim Ent As AcadEntity, Atext1 As AcadText, Atext2 As AcadText, SS As AcadSelectionSet, HT As Object
Set SS = FA_SSL("Layer1"): Set HT = CreateObject("System.Collections.Hashtable")

For Each Ent In SS

    If TypeOf Ent Is AcadText Then
    
        Set Atext1 = Ent
        
            Set Atext2 = Atext1.Copy
            Atext2.Layer = "Layer2"
    
        End If

Next Ent

End Sub

Function FA_SSL(NameLayer As String) As AcadSelectionSet 'Create a selection group based on layer

On Error Resume Next: ThisDrawing.SelectionSets.Item("SS00").Delete: On Error GoTo 0

Dim filterType(0) As Integer, filterData(0) As Variant
Set FA_SSL = ThisDrawing.SelectionSets.Add("SS00")
filterType(0) = 8: filterData(0) = NameLayer
FA_SSL.Select acSelectionSetAll, , , filterType, filterData

End Function

 

 

 I did not do the work about the dictionary, but that code copy all the texts in "layer1" and put in same coords in "layer2".

 

I belive that u can adapt it to your situation and get sucessful!

 

Glad to help 🙂

0 Likes
Message 3 of 5

aaron.wrightCPM6Y
Contributor
Contributor

Hi! Perfect thank you. I've manage to amend the code and get it working in my script.

 

Although I'm not entirely sure what all the code is doing.

 

Atext2.Layer = "Layer2"

 

Is the above essentially just copying the text to Layer2?

 

And regarding the SSL function, is there somewhere I can learn more about this? I understand generally what it's doing, but don't really understand how it's doing it. 

0 Likes
Message 4 of 5

seabrahenrique
Advocate
Advocate

Right!

 

At this moment (Atext2.Layer = "Layer2") the code put your text2 in layer2, only that. The copy moment is: (Set Atext2 = Atext1.copy)

 

About the SSL, is one of my own functions to filter objectos on certain layers... but u can read more about this here: https://documentation.help/AutoCAD-ActiveX-AAG/WS1a9193826455f5ff1a32d8d10ebc6b7ccc-6c16.htm

 

As i say, u can use this function to filter objects by layers, types and anothers ways....

 

Remember mark as a solution if the code solve your problem 

 

Glad to help 🙂

0 Likes
Message 5 of 5

aaron.wrightCPM6Y
Contributor
Contributor

Perfect thank you for the help! I've accepted your solution.