Добрый день. Пытаюсь адаптировать скрипт Vit'a (Царствие ему небесное) Reiteration ( который находит в тексте повторения однокоренных слов на расстоянии, заданном пользователем) для использования под LibreOffice.
| Код |
REM ***** BASIC *****
Sub Main
Reiteration
End Sub
' Функция подсчитывает количетсво слов в документе
' Нам она нужна только для определения объема
' оставшейся работы для скрипта
' Решает задачу "в лоб"
Function GetTotalWordsCount() As Integer
Dim Doc As Object
Dim Cursor As Object
Dim WordsCount As Integer
Dim Proceed As Boolean
Doc = ThisComponent
Cursor = Doc.Text.createTextCursor
WordsCount = 0
Do
WordsCount = WordsCount + 1
Proceed = Cursor.gotoNextWord(False)
Loop While Proceed
GetTotalWordsCount = WordsCount
End Function
' Функция получения корня слова (работает только для русского языка)
Public Function GetRoot(s) As String
GetRoot = ""
s = Replace(Replace(Replace(Replace(Trim(s), ",", ""), ".", ""), ":", ""), "-", "")
s = LCase(s)
If Len(s) < 2 Then _
Exit Function
If Len(s) <= 4 And InStr("не ли ни то ну или если что без нет как либо то" _
, s) > 0 Then _
Exit Function
If Len(s) >= 2 And InStr("ой ая ое ам ям ом ем ин ём ся ет ит ут ют ат ят ыв ив ев ан ян ов ев ог ег ир ер ых ок ющ ущ er ed" _
, Right(s, 2)) > 0 Then _
s = Left(s, Len(s) - 2)
If Len(s) >= 3 And InStr("енн овл евл ённ анн ост ест" _
, Right(s, 3)) > 0 Then _
s = Left(s, Len(s) - 3)
If Len(s) = 0 Then _
Exit Function
If Left(s, 4) = "пере" Then
s = Right(s, Len(s) - 4)
Else
If Len(s) >= 3 And InStr("при рас пре про под", Left(s, 3)) > 0 Then
s = Right(s, Len(s) - 3)
Else
If Len(s) >= 2 And InStr("на за ис из до по вы во со", Left(s, 2)) > 0 Then
s = Right(s, Len(s) - 2)
Else
If InStr("в с", Left(s, 1)) > 0 Then
s = Right(s, Len(s) - 1)
End If
End If
End If
End If
GetRoot = s
End Function
Sub Reiteration
'
' ******************** В помощь писателю ******************************
' * Этот макрос выделяет повторы слов в тексте *
' * *
' * Copyright (c) Vitaly Nevzorov, 2008, [email protected] *
' * Распространение свободное :) *
' * Пользуйтесь на здоровье! *
' * *
' * Вы можете настроить чувствительность, по умолчанию выделяются *
' * все однокоренные слова, находящиеся на расстоянии менее 10 слов *
' * в следующей строке вы можете поставить другую чувствительность: *
Const Sensitivity = 10
' * *
' * Alexandr Sysoev - Внесён ряд изменений: *
' * 1 - Переделан алгоритм с целью увеличения скорости работы. *
' * Скорость увеличена в 15-20 раз! *
' * 2 - Добавлен замер времени выполнения *
' * 3 - Исправлена ошибка: *
' * Исходный вариант не находил повторы в конце документа, среди *
' * последних Sensitivity слов. *
' * 4 - Исправлена неточность (спорная): *
' * Исходный вариант учитывал незначащие слова (для которых *
' * функция GetRoot возвращает пустую строку) при вычислении *
' * расстояния. Мой вариант их не считает. *
' * 5 - В конец макроса добавлен вывод модального сообщения о *
' * завершении работы. Мне показалось так удобнее, хотя это спорно.*
' * 6 - Добавлен сброс атрибута подчеркивания для всего документа *
' * перед началом работы. Не уверен что это хорошо, поскольку *
' * может испортить пользовательское форматирование. *
' * Лучше наверное чистить более избирательно, но лень :).
' * Портировал для OpenOffice/LibreOffice Alexey Protchenko aka Severyanin, [email protected]
' ***********************************************************************
Dim Doc As Object
Dim Cursor As Object
Dim Proceed As Boolean
Dim Total,Found,i,J,N As Integer
Dim W As String
Dim WDict(Sensitivity - 1)
Dim WRanges(Sensitivity - 1) As Object
Doc = ThisComponent
Cursor = Doc.Text.createTextCursor
Total = GetTotalWordsCount()
'MsgBox CStr(Total)
i = 0
N = 0
Found = 0
Do
Cursor.gotoEndOfWord(True)
i = i + 1
W = GetRoot(Cursor.String)
If Len(W) > 1 Then
For J = 0 To Sensitivity - 1
If W = WDict(J) Then
Cursor.gotoEndOfWord(True)
Cursor.CharUnderline = com.sun.star.awt.FontUnderline.DOUBLEWAVE
Cursor.CharColor = com.sun.star.util.Color.blue
Found = Found + 1
End If
Next J
NextIter: WDict(N) = W
Set WRanges(N) = WR
N = (N + 1) Mod Sensitivity
End If
Proceed = Cursor.gotoNextWord(False)
Loop While Proceed
MsgBox "Найдено повторов слов: " & Round(Found * 100 / Total, 2) & "%"
End Sub
|
Код взят из оригинального скрипта (за исключением части, которая отвечает за взаимодействие с объектами документа). Проблема в том, что в части
| Код |
If W = WDict(J) Then
Cursor.gotoEndOfWord(True)
Cursor.CharUnderline = com.sun.star.awt.FontUnderline.DOUBLEWAVE
Cursor.CharColor = com.sun.star.util.Color.blue
Found = Found + 1
Exit For
End If
|
на строке Exit For вываливается сабжевая ошибка. Причем если строку заекомментить, ошибка указывает на нее же. При удалении - на предыдущую. Не могу отловить причину ошибки - все переменные объявлены ранее и инициализированы. Буду очень благодарен за помощь.
С уважением, Северянин
Добавлено через 1 минуту и 49 секунд
P.S. Ошибка вываливается при компиляции. Версия LibreOffice: 4.0.2.2 (Build ID: 400m0(Build:2)) ОС - Linux Mint 15 olivia |