please I want help in this problem (replace multiple texts to multiple texts)

[eng_minamaged]

please I want help with this problem

for example, I have text

00-1

00-3

00-7

00-10

I want to replace---- with -----

00-1------00-2

00-2------00-3

00-3------00-4

00-4------00-5

when I used bfind lisp the result

00-1------00-5

00-2------00-5

00-3------00-5

00-4------00-5

all text become 00-5

I want the solution to obtain 

00-1------00-2

00-2------00-3

00-3------00-4

00-4------00-5

in multiple dwgs (Lisp file or Visual basic or any Ready method)

[grobnik]

Hi @eng_minamaged 

here a simple code that I tested.

Sub TextSubstitution()
Dim MyText As Variant
Dim ObjectText As Object
Dim MyPos As Integer
Dim MyLeft As Variant
Dim MyRight As Variant
Dim MyRightValue As Integer
Dim MyNewString As Variant
For Each ObjectText In ThisDrawing.ModelSpace
    If TypeOf ObjectText Is AcadText Or TypeOf ObjectText Is AcadMText Then
        MyText = ObjectText.TextString
        MyPos = InStr(1, MyText, "-", vbTextCompare)
        MyLeft = Left(MyText, MyPos - 1)
        MyRight = Right(MyText, Len(MyText) - MyPos)
        MyRightValue = Val(MyRight)
        MyNewString = MyLeft & "-" & Mid(Str(MyRightValue + 1), 2, Len(Str(MyRightValue + 1)))
        ObjectText.TextString = MyNewString
    End If
Next
End Sub

Code consist of searching on ModelSpace a text and increase by 1 unit the last number after "-".

Code it's working with last digit by one, two or three digits.

Source:

After Running procedure

Before Running procedure 2nd test with three digits

After 

I hope this will solve your issue.

Concerning the huge amount of dwg you can enlarge procedure with automatically open file from a list of drawing name with path, apply procedure, save with another name.

I'll show you how soon if you are interested also for this part.

Regards

[eng_minamaged]

I am very sorry duplicate post I don't wan't increase one in dwgs in the end text

1- replace not increase 1

2-not at end 

to exact example:

9Y25@200-----8Y25@220

30Y25@200----27Y25@220 

8Y25@200----7Y25@220

....

...

...

...

...

..

..

bfind lisp

9Y25@200-----7Y25@220     false result I want 8Y25@220

30Y25@200----27Y25@220 

8Y25@200----7Y25@220

in multiple dwgs

[grobnik]

Hi @eng_minamaged, 

Sorry but I do not understand, if you want an automatic system there should be a rule, in your previous post you wrote:

I want the solution to obtain 

00-1------00-2

00-2------00-3

00-3------00-4

00-4------00-5

So I understand you want to increase by one unit.

Now you are writing

9Y25@200-----8Y25@220

30Y25@200----27Y25@200  

Please let us know the rules when you have to increase @200 to @220, and when 30Y to 27Y.

In any case, with code I show you whenever you have the found text to replace with IF or CASE functions you can manipulate the string as you want.

For example:

For Each ObjectText In ThisDrawing.ModelSpace
    If TypeOf ObjectText Is AcadText Or TypeOf ObjectText Is AcadMText Then
        MyText = ObjectText.TextString
        '
        ' write here code for text search to replace rules
        '           
        MyNewString = 'XXXX New String Manipulated
        ObjectText.TextString = MyNewString 'replace found text with new text.
    End If
Next

Concerning the multiple open file you can create a text file with filename (see attached), define a path and use a procedure like this

MyPath = "C:\Users\Utente\Documents\"
Open "TextReplace.txt" For Input As #1

Do While Not EOF(1)
Input #1, FileName
ThisDrawing.Application.Documents.Open (MyPath & FileName)
    'STRING MANIPULATION PROCEDURE
    'For Each ObjectText In ThisDrawing.ModelSpace
    '
ThisDrawing.SaveAs (MyPath & FileName & "_REVISED")
ThisDrawing.Close

Loop
Close #1

Regards

[eng_minamaged]

Thank you very much for your interest in my question

I want to change the distance 200 to 220 so I want to change the number

X*200=Y*220

so I want change the number of steel x to y due to change in the distance 200 to 220

so I made Excel file from 3Y200 to 200Y200 and obtained the result---- *Y220 but I can't replace the data in AutoCAD

I attached the excel file

11Y200----10Y220
43Y200----39Y220
58Y200----53Y220
57Y200----52Y220
75Y200----68Y220

.....

.....

..

..

..

[grobnik · Accepted solution]

Hi @eng_minamaged 

Sorry but my mind it's not so smart, the distance from 200 to 220 it's more or less clear.

But what it's not clear is the X to Y, seems you want to check also if new Y value shall be not used in the drawing ?

How determinate the new Y value ?

I can help you but if I not understand the rules I cannot.

However if you have a minimal VBA (or VB) experience, try to use above code to find all text, filter with your requirements, replace.

Procedure it's more or less simple, it's based upon string manipulation.

Concerning the multiple file read the above post.

Regards

[eng_minamaged]

thank you very much for your time I will try and  I would be grateful for your presence if I made it

[grobnik]

@eng_minamaged 

However if you already have the excel file, I'll show you how to find text in the excel first column, and replace with the second column content in the same row.

But you should have the same text in dwg, without space or other, this is the main issue.

Bye

[eng_minamaged]

Thank you

I am sorry for not communicating the information well

Yes, I have Excel file

I sent it 

[grobnik]

@eng_minamaged 

Hi, here the code, please check the row, and column to start and the end, in case replace.

Be careful you should have excel file already open, in case you can open automatically but it's require additional code and so on.

I left also the multiple file dwg open part

Sub TextSubstitution()
Dim MyText As Variant
Dim ObjectText As Object
Dim ExRow As Integer
Dim MyNewString As Variant
Dim MyPath As Variant
Dim FileName As Variant

MyPath = "C:\Users\Utente\Documents\"

Set ExcelFileOpened = GetObject(, "Excel.Application")
Set Wrks = ExcelFileOpened.ActiveSheet
ExRow = 4
ExCol = 8

Open "TextReplace.txt" For Input As #1
Do While Not EOF(1)
Input #1, FileName
ThisDrawing.Application.Documents.Open (MyPath & FileName)
    
For Each ObjectText In ThisDrawing.ModelSpace
    If TypeOf ObjectText Is AcadText Or TypeOf ObjectText Is AcadMText Then
        MyText = ObjectText.TextString
        For Each Cella In Wrks.Range("H4:H286")
            TextToFind = Cella.Value
            If StrComp(TextToFind, MyText, vbBinaryCompare) = 0 Then
                ExRow = Cella.row
                ObjectText.TextString = Wrks.Range("I" & ExRow).Value
            End If
        Next
    End If
Next

ThisDrawing.SaveAs (MyPath & FileName & "_REVISED")
ThisDrawing.Close

Loop
Close #1
End Sub

The drawing, whenever modified will be saved ad "_REVISED" addition to filename.

Let me know.