Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

16 Июль 2019, 17:29 *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

Войти
Новости: Доступно и просто о работе в офисных пакетах
 
   Начало   Помощь Поиск Войти Регистрация    задать вопрос  
Страниц: 1   Вниз
  Печать  
Автор Тема: Копирование 3D-объектов в DRAW  (Прочитано 2044 раз)
0 Пользователей и 1 Гость смотрят эту тему.
vla.dik
Новичок
*
Offline Offline

Сообщений: 2


« Стартовое сообщение: 24 Июнь 2016, 13:33 »

Добрый день!
Такой вопрос: можно ли программно не при помощи буфера обмена копировать 3-D объекты в DRAW?
У меня получилось копировать только с помощью DispatchHelper командами ".uno:Copy" и ".uno:Paste".
Но они работают достаточно медленно.

Вот код:
Код:
Sub Main
Dim Point As New com.sun.star.awt.Point
Dim MaxY

Ticks = GetSystemTicks()

Doc = ThisComponent

Point.x = 500
Point.y = 500
MaxY = 500

dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

NewDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw" ,"_blank", 0, Array())
NewDoc.CurrentController.CurrentPage.BorderLeft = 500
NewDoc.CurrentController.CurrentPage.BorderRight = 500
NewDoc.CurrentController.CurrentPage.BorderTop = 500
NewDoc.CurrentController.CurrentPage.BorderBottom = 500

for p = 0 to ThisComponent.DrawPages.Count - 1
Page = Doc.DrawPages(p)
for e = 0 to Page.Count - 1
Elem = Page(e)
if Elem.UINamePlural = "Трёхмерные сцены" then
for b = 0 to Elem.Count - 1
Shape = Elem(b)
Doc.CurrentController.Select(Shape)
If Point.x > 500 Then
If Point.x + Shape.Size.Width + 500 > NewDoc.CurrentController.CurrentPage.Width Then
Point.x = 500
If MaxY + Shape.Size.Height > NewDoc.CurrentController.CurrentPage.Height Then
NewPage = NewDoc.DrawPages.insertNewByIndex(NewDoc.DrawPages.Count)
NewDoc.CurrentController.setCurrentPage(NewPage)
Point.y = 500
MaxY = 500
Else
Point.y = MaxY
End If
End If
End If
Wait 100 ' Без паузы LibreOffice зависает
dispatcher.executeDispatch(Doc.CurrentController.Frame, ".uno:Copy", "", 0, Array())
dispatcher.executeDispatch(NewDoc.CurrentController.Frame, ".uno:Paste", "", 0, Array())
NewShape = NewDoc.CurrentController.GetSelection(0).GetByIndex(0)
NewShape.Position = Point
Point.x = Point.x + Shape.Size.Width + 500
NewPosY = Point.y + Shape.Size.Height + 500
If NewPosY > MaxY Then
MaxY = NewPosY
End If
next b
end if
next e
next p

MsgBox("Закончили: " & (GetSystemTicks() - Ticks) / 1000)

End Sub

Файл примера во вложении.
Спасибо.

* PerenosBukv.odg (94.23 Кб - загружено 5 раз.)
Записан
vla.dik
Новичок
*
Offline Offline

Сообщений: 2


« Ответ #1: 27 Июнь 2016, 07:40 »

Добрый день!
Я почему спрашиваю насчет копирования объектов не через буфер обмена - в DRAW есть пункт меню "Правка" - "Размножить" ("Edit" - "Duplicate") - вызывается комбинацией <Shift+F3>.
Вот эта команда быстро работает - пробовал делать 100 копий, очень быстро сделались.
Есть ли возможность вызвать эту команду программно из LibreOffice Basic?
Никто не знает?
Заранее спасибо.
Записан
Bigor
Опытный пользователь
***
Offline Offline

Пол: Мужской
Сообщений: 613


« Ответ #2: 1 Апрель 2019, 18:29 »

Подниму вопрос.

Можно ли с помощью макроса копировать объекты Draw в другой документ.
(без DispatchHelper)?

Вдруг за 3 года чего изменилось Улыбка
Записан
Страниц: 1   Вверх
  Печать  
 
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2009, Simple Machines Valid XHTML 1.0! Valid CSS!