Копирование 3D-объектов в DRAW

Автор vla.dik, 24 июня 2016, 13:33

0 Пользователи и 1 гость просматривают эту тему.

vla.dik

Добрый день!
Такой вопрос: можно ли программно не при помощи буфера обмена копировать 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


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

vla.dik

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

bigor

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

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

Вдруг за 3 года чего изменилось :)
Поддержать разработчиков LibreOffice можно можно тут, а наш форум вот тут