Vba excel NanoCAD (AutoCAD) Показать количество найденных фрагментов текста
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Vba excel NanoCAD (AutoCAD) Показать количество найденных фрагментов текста

Vba excel NanoCAD (AutoCAD) Показать количество найденных фрагментов текста

Ответ
Поиск в этой теме
Непрочитано 30.10.2024, 09:19 #1
Vba excel NanoCAD (AutoCAD) Показать количество найденных фрагментов текста
olga87
 
Регистрация: 28.05.2007
Сообщений: 229

Здравствуйте Уважаемые специалисты AutoCAD!

Ниже есть код vba-excel, который позволяет произвести поиск и замену фрагмента текста (old_txt) на нужный (new_txt). Этот макрос проходит по всем одно- и многострочным текстам текущего чертежа.

Подскажите пожалуйста, как дополнить этот код, что выдавалось сообщение о количестве найденных фрагментов текста и в скольких Текстах или МТекстах, например, "Заменено в N объектах-текстах N фрагментов.".

Заранее спасибо!

Код:
[Выделить все]
Public app As nanoCAD.Application
Dim old_txt As String, new_txt As String
Dim wrksht As Worksheet

Sub SReplace()
    Set wrksht = ActiveWorkbook.Worksheets("Замена_текста")
    
    old_txt = wrksht.Cells(2, 1)
    new_txt = wrksht.Cells(2, 2)
    
On Error Resume Next
'получить запущенный нанокад
Set app = GetObject(, "nanoCAD.Application.24.0")
'если нет ни одного запущенного приложения Нанокад, получаем ошибку
If Err.Number > 0 Then
Err.Clear
MsgBox ("NanoCAD 24.0 не запущен.")
Exit Sub
End If

    Call ReplaceText(app.ActiveDocument)
    
    MsgBox "Замена завершена", vbInformation, "Finished"
    
End Sub

Private Sub ReplaceText(doc As nanoCAD.Document)
'    Замена текста:
    Dim ent As AcadEntity

    For Each ent In doc.ModelSpace
        If TypeOf ent Is AcadMText Or TypeOf ent Is acadText Then
            ent.TextString = Replace(ent.TextString, old_txt, new_txt)
        End If
    Next

    For Each ent In doc.PaperSpace
        If TypeOf ent Is AcadMText Or TypeOf ent Is acadText Then
            ent.TextString = Replace(ent.TextString, old_txt, new_txt)
        End If
    Next

End Sub

Последний раз редактировалось olga87, 30.10.2024 в 09:43.
Просмотров: 1091
 
Непрочитано 30.10.2024, 14:08
#2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,406


Я бы подумал на предмет объявления доп.переменной - счетчика, и перед Replace выполнить доп.проверку по принципу:
Код:
[Выделить все]
For Each ent In doc.ModelSpace
    If TypeOf ent Is AcadMText Or TypeOf ent Is acadText Then
        If ent.TextString.Contains(old_txt) Then
            mTextCounter = mTextCounter + 1
            ent.TextString = Replace(ent.TextString, old_txt, new_txt)
        End If
    End If
Next
P.S. На VB[A/s/...] не пишу

----- добавлено через ~2 мин. -----
Offtop: Хотя я бы всерьез задумался о прохождении вообще по всем блокам. Ну и про поля не стоит забывать, и про атрибуты... Задачка перестает быть элементарной
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 30.10.2024, 14:36
#3
olga87


 
Регистрация: 28.05.2007
Сообщений: 229


Спасибо! посмотрю.
olga87 вне форума  
 
Непрочитано 31.10.2024, 02:10
#4
Нубий-IV

Инженер-философ
 
Регистрация: 24.04.2019
Хабаровск
Сообщений: 2,071


А еще прямо внутри одного текста может быть несколько вхождений. А еще бывают перепутаны кириллица/латиница типа с/c. А еще бывает взорванный мультитекст, когда часть вхождения попала в один текст, а часть - в другой.
Нубий-IV вне форума  
 
Автор темы   Непрочитано 31.10.2024, 07:08
#5
olga87


 
Регистрация: 28.05.2007
Сообщений: 229


Цитата:
Сообщение от Нубий-IV Посмотреть сообщение
А еще прямо внутри одного текста может быть несколько вхождений. А еще бывают перепутаны кириллица/латиница типа с/c. А еще бывает взорванный мультитекст, когда часть вхождения попала в один текст, а часть - в другой.
Поэтому хотя бы выводить информацию о "в скольких текстах найдено и сколько повторений в одном тексте.
olga87 вне форума  
 
Автор темы   Непрочитано 31.10.2024, 11:54
#6
olga87


 
Регистрация: 28.05.2007
Сообщений: 229


Фрагмент кода ниже выдает в скольких объектах-текстах встречается искомый текст (mTextCounterM):

Код:
[Выделить все]
mTextCounterM = 0
    For Each ent In doc.ModelSpace
        If TypeOf ent Is AcadMText Or TypeOf ent Is acadText Then

            If InStr(ent.TextString, old_txt) > 0 Then
              mTextCounterM = mTextCounterM + 1
              ent.TextString = Replace(ent.TextString, old_txt, new_txt)
            End If

        End If
    Next
Подскажите пожалуйста, как узнать количество вхождений в одном объекте-тексте?
olga87 вне форума  
 
Непрочитано 31.10.2024, 12:21
#7
Нубий-IV

Инженер-философ
 
Регистрация: 24.04.2019
Хабаровск
Сообщений: 2,071


На NETах, питонах и прочих скриптах популярен поиск через регулярные выражения. Создается объект RegEx с образцом строки для поиска. И вызов метода RegEx.Match(string) возвращает коллекцию, у которой счетчик показывает сколько вхождений найдено. Этот же объект умеет делать замены. Как выглядит синтаксис конкретно в VBA, и какую библиотеку подключить надо - придется гуглить RegEx + VBA.
Нубий-IV вне форума  
 
Непрочитано 31.10.2024, 12:42
#8
name02


 
Регистрация: 10.01.2020
Сообщений: 415


попробуй такой код:
Код:
[Выделить все]
For Each ent In doc.ModelSpace
    If TypeOf ent Is AcadMText Or TypeOf ent Is acadText Then
        
        mTextCounterM = 0
        Start = 1

        Do
          pos = InStr(Start, ent.TextString, old_txt, vbTextCompare)
          If pos > 0 Then
            Start = pos + Len(srch)
            mTextCounterM = mTextCounterM + 1
          End If
        Loop While pos > 0
        
        If mTextCounterM > 0 Then ent.TextString = Replace(ent.TextString, old_txt, new_txt)

    End If
Next
name02 вне форума  
 
Непрочитано 31.10.2024, 12:47
#9
Нубий-IV

Инженер-философ
 
Регистрация: 24.04.2019
Хабаровск
Сообщений: 2,071


Пример:
Код:
[Выделить все]
Sub s()
    Dim re As New RegExp
    re.Pattern = "Test"
    re.Global = True
       
    Dim s As String
    s = "Test Test Test"
    
    Set matches = re.Execute(s)
    
    MsgBox matches.Count() ' Показывает 3
End Sub
Надо подключить "Microsoft VBScript Regular Expression 5.5" через Tools/References
Нубий-IV вне форума  
 
Непрочитано 31.10.2024, 13:03
#10
name02


 
Регистрация: 10.01.2020
Сообщений: 415


Если через регулярные делать, тогда уж и замену выполнить через них:
Код:
[Выделить все]
Dim regexOne As Object
Set regexOne = CreateObject("VBScript.RegExp")

'Можно объявить объект и так, но тогда нужно
'подключить "Microsoft VBScript Regular Expression 5.5" через Tools/References
'Версия на компьютере может меняться и нужно будет заново подключать имеющуюся
'Dim regexOne As RegExp
'Set regexOne = New RegExp
For Each ent In doc.ModelSpace
    If TypeOf ent Is AcadMText Or TypeOf ent Is acadText Then
         regexOne.Pattern = old_txt
         regexOne.Global = True

         mTextCounterM = mTextCounterM + regexOne.Execute(ent.TextString).Count
         ent.TextString= regexOne.Replace(ent.TextString, new_txt)
    End If
Next

Последний раз редактировалось name02, 31.10.2024 в 15:08.
name02 вне форума  
 
Автор темы   Непрочитано 31.10.2024, 15:28
#11
olga87


 
Регистрация: 28.05.2007
Сообщений: 229


Спасибо Вам большое!!
Буду изучать и пробовать.
olga87 вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Vba excel NanoCAD (AutoCAD) Показать количество найденных фрагментов текста

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Вставка блока в таблицу AutoCAD по данным из Excel VicZel AutoCAD 1 25.06.2019 17:21
Связка AutoCAD с Excel через командную строку. raffnec AutoCAD 9 19.09.2016 10:54
Перенос данных из Excel в Autocad 2010 Pontelimon AutoCAD 3 19.11.2010 13:36
Excel vs Autocad - размеры и текст Dec0rator Программирование 22 08.11.2010 14:00