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