vba excel Изменить содержимое текстов в выносках-СПДС NanoCAD

Question

Как с помощью Excel и VBA заменить для универсальных выносок (СПДС-выносок) в чертеже NanoCAD все найденные в текстах заглавные русские буквы на заглавные английские?

Задача такая:

В чертеже уже есть выноски-СПДС (были как-то проставлены).
Нужно выбрать их выборочно и заменить русские буквы на подобные английские, т.е. "E", "T", "O", "P", "A", "H", "K", "X", "C", "B", "M" в 2-х строках.

В данный момент не получается обратиться к тексту через VBA, чтобы заменить содержимое у объекта "mcsDbObjectNotePosition":

Set SPDS = CreateObject("McCOM2.Server")
objSelectionSet.SelectOnScreen

For Each ent In objSelectionSet
If ent.ObjectName = "mcsDbObjectNotePosition" Then
...

Подскажите, как обратиться к содержимому верхней и нижней полки (Text и Footer)?

Answer 1

можно создать массивы с символами которые надо заменять, если тезисно то решение вижу так:

Sub ReplaceCyrillicWithLatin()
    Dim nanoApp As Object
    Dim doc As Object
    Dim selSet As Object
    Dim ent As Object
    Dim textVal As String
    
    ' Подключение к NanoCAD
    Set nanoApp = CreateObject("McCOM2.Application")
    Set doc = nanoApp.ActiveDocument
    Set selSet = doc.SelectionSets.Add("MySelection")
    
    On Error Resume Next
    selSet.Clear
    On Error GoTo 0
    
    MsgBox "Выделите нужные выноски и нажмите Enter"
    selSet.SelectOnScreen
    
    ' Таблица замены
    Dim rusLetters As Variant, latLetters As Variant
    rusLetters = Array("А", "В", "Е", "К", "М", "Н", "О", "Р", "С", "Т", "У", "Х")
    latLetters = Array("A", "B", "E", "K", "M", "H", "O", "P", "C", "T", "Y", "X")
    
    ' Обход всех объектов в выборке
    For Each ent In selSet
        If ent.ObjectName = "mcsDbObjectNotePosition" Then
            ' Верхняя строка (Text)
            If Not IsEmpty(ent.Text) Then
                ent.Text = ReplaceLetters(ent.Text, rusLetters, latLetters)
            End If
            
            ' Нижняя строка (Footer)
            If Not IsEmpty(ent.Footer) Then
                ent.Footer = ReplaceLetters(ent.Footer, rusLetters, latLetters)
            End If
        End If
    Next
    
    MsgBox "Завершено."
End Sub

Function ReplaceLetters(inputStr As String, rusLetters As Variant, latLetters As Variant) As String
    Dim i As Integer
    For i = LBound(rusLetters) To UBound(rusLetters)
        inputStr = Replace(inputStr, rusLetters(i), latLetters(i))
    Next i
    ReplaceLetters = inputStr
End Function

Объекты mcsDbObjectNotePosition поддерживают свойства .Text и .Footer — если не работает, возможно, доступ нужно через GetParam или через .Attributes — тогда подскажу дополнительно.

если я правильно понял, то должно получится До: ПРИВЕТ, СЕРГЕЙ! После: PRIVET, CERGEI!

БЛОГ НА HUSL

vba excel Изменить содержимое текстов в выносках-СПДС NanoCAD

Ответы (1 шт):