Отбор из предложения слов на каком-то языке.

[RFJ]

Есть предложения со словами на разных языка. Например (русские + английские):

В обратную сторону (this вместо that, these вместо those) замену производить нельзя. Другими словами, в разговорной речи that более популярно, чем this, a those - чем these.

Как из этого предложения отобрать только слова на английском языке, т.е. получить набор (предложение):

this; that; these; those; that; this; those; these

?
(Уникальность слов набора не нужна.)

PS. Вместо английского может фигурировать любой другой язык: французский, испанский, китайский, ...

[JohnSUN]

То есть, любые слова написанные без использования кириллицы? Без букв [А-я]?
Первое, что приходит в голову - замена с регулярным выражением...

[RFJ]

Нет, не заменить строки, удалив русские символы.
Нужно получить отдельный набор, не меняя исходного предложения, в виде строковой переменной, например.
Т.е., типа
engstr="this; that; these; those; that; this; those; these"

[Рыбка Рио]

REM  *****  BASIC  *****

Dim floatingwindow As Object
Dim floatingframe As Object
Dim zToolkit As Object
Dim CW As Object

Sub Main
Doc=ThisComponent
SD = Doc.createSearchDescriptor
SD.SearchRegularExpression=True
SD.SearchCaseSensitive = False
SD.SearchString = "[a-zà-ÿ]{2,}"
Result = Doc.findAll(SD)
N = Result.Count-1
sText=""
For i=0 to N-1
sText=sText+Result(i).String+"; "
Next
sText = sText+Result(N).String

CW=Doc.CurrentController.ComponentWindow
zToolkit=CW.getToolkit()

floatingframe = GetProcessServiceManager.createInstanceWithContext("com.sun.star.frame.Frame", GetDefaultContext)
floatingwindow = CreateWindow(zToolkit, MkRk(850,50,200,150))
floatingframe.initialize(floatingwindow)

ucc = CreateCtrWithProp( "Container", MkRk(0,0,200, 150), Array(), Array())
ucc.createPeer( zToolkit, floatingwindow )
floatingframe.setComponent(ucc,Null)
oEdit1 = CreateCtrWithProp( "Edit", MkRk(0,0,200,150), Array("MultiLine","VScroll","Text"), Array(true,true,sText))
ucc.addControl("Edit1",oEdit1)
End Sub

Function MkRk( nX As Long, nY As Long, nWidth As Long, nHeight As Long ) As com.sun.star.awt.Rectangle
  Dim Rk As Object
  Rk = createUnoStruct("com.sun.star.awt.Rectangle")
  With Rk
     .X = nX
     .Y = nY
     .Width = nWidth
     .Height = nHeight
  End With
  MkRk() = Rk
End Function

Function CreateWindow( oLocToolkit As Object, aLocRect As com.sun.star.awt.Rectangle ) As com.sun.star.awt.WindowDescriptor
Dim WDesc
WDesc = createUnoStruct("com.sun.star.awt.WindowDescriptor")
With WDesc
.Type = com.sun.star.awt.WindowClass.SIMPLE
.WindowServiceName = "floatingwindow"
.Parent = CW
.ParentIndex = -1
.Bounds = aLocRect
End With
With com.sun.star.awt.WindowAttribute
WDesc.WindowAttributes = .BORDER + .SHOW + .SIZEABLE + .MOVEABLE + .CLOSEABLE
End With
CreateWindow = oLocToolkit.createWindow(WDesc)
End Function

Function CreateCtrWithProp( CtrType, aPosSize, aPropNames, aPropValues )
Dim oCtr As Object, oCtrModel As Object
oCtr = createUnoService("com.sun.star.awt.UnoControl" & CtrType )
oCtrModel = createUnoService("com.sun.star.awt.UnoControl" & CtrType & "Model" )
oCtrModel.setPropertyValues( aPropNames, aPropValues )
With oCtr
.setModel(oCtrModel)
.setPosSize( aPosSize.X, aPosSize.Y, aPosSize.Width, aPosSize.Height, _
com.sun.star.awt.PosSize.POSSIZE )
End With
CreateCtrWithProp() = oCtr
End Function

[JohnSUN]

Вот-вот, что-то в этом роде я имел в виду... Только "с точностью до наоборот"  В смысле, искать не символы [a-zà-ÿ]{2,}, а [^А-я() .,]+.
Кстати, из-за {2,} можем пропустить артикль "a" (в строке-примере он находится здесь -  "чем this, a those") 

[RFJ]

Клио
Это просто разбивает на слова, без отбора только английских слов.

[вложение удалено Администратором]

[RFJ]

Кроме того, нужно результат отбора только английских слов передать в переменную или массив для дальнейшей обработки.

Плавающее окошко не нужно.

[Рыбка Рио]

Клио
Это просто разбивает на слова, без отбора только английских слов.

Это какое-то недоразумение. Вы уверены, что у вас ищется выражение [a-zà-ÿ]{2,} . Оно просто никак не может вам выдавать слова на кириллице. (Макрос ищет слова с символами a-z и à-ÿ длиной более двух букв (не только английские, но и те которые пишутся на латинице + расширенной латинице))

Если плавающее окошко не нужно, то тогда совсем просто (тут ищет [a-zà-ÿ]{1,} , т.е. одиночные латинские буквы тоже ищет):

Sub Main
Doc=ThisComponent
SD = Doc.createSearchDescriptor
SD.SearchRegularExpression=True
SD.SearchCaseSensitive = False
SD.SearchString = "[a-zà-ÿ]{1,}"
Result = Doc.findAll(SD)
N = Result.Count-1
Dim sText(N) As String
For i=0 to N
sText(i)=Result(i).String
Next
msgbox join(sText)
End Sub

[JohnSUN]

Насколько я смог понять из нескольких кусков описания, задача состоит в следующем:
требуется функция, которая получив в качестве параметра текст (строку? или документ? или текстовый курсор? или текущее выделение?), выберет отдельные слова по локали (по вхождению символов в строку-шаблон?) и вернёт их в том же порядке, как они встречались в тексте, в виде строки с каким-то разделителем (или в виде массива?) для дальнейшей обработки.
Я бы за базу взял у Питоньяка Listing 5.67: Set the locale for selected text (or the document).

[RFJ]

Клио
Первый макрос работает, просто при копировании моей Оперой неправильно скопировалось выражение [a-zà-ÿ].
Второй тоже работает.
Но при таком подходе нельзя отделить слова на английском от слов на немецком, например:

В обратную сторону (this вместо that, these вместо those) замену производить нельзя.
Другими словами, в разговорной речи that более популярно, чем this, а those - чем these.
Lesen Sie dieses Handbuch gut durch.

JohnSUN
Питоньяка посмотрю.

[Рыбка Рио]

Тогда так?

REM  *****  BASIC  *****

Sub Main
Doc=ThisComponent
SD = Doc.createSearchDescriptor
SD.SearchRegularExpression=True
SD.SearchCaseSensitive = False
SD.SearchString = "[a-zà-ÿ]{1,}"
Dim aLocale As New com.sun.star.lang.Locale
slocale = split(inputbox("en-US, de-DE?","","en-US"),"-")
If slocale(0)="" then Exit Sub
aLocale.Language = slocale(0)
aLocale.Country = slocale(1)
Dim prop As New com.sun.star.beans.PropertyValue
prop.Name = "CharLocale"
prop.Value = aLocale
SD.setSearchAttributes(Array(prop))
Result = Doc.findAll(SD)
N = Result.Count-1
Dim sText(N) As String
For i=0 to N
sText(i)=Result(i).String
Next
msgbox join(sText)
End Sub

[RFJ]

Клио
Спасибо, все работает.

JohnSUN
Спасибо, разобрался.