[Решено] Кривые Безье в Draw

Автор spyAndrey, 30 мая 2016, 23:34

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

spyAndrey

Вот код:
Sub DrawClosedBezierShape
Dim oDoc
Dim oPage
'Страница для рисования
Dim oShape 'Фигура для вставки
Dim oCoords 'Координаты многоугольника для вставки
oCoords = createUnoStruct("com.sun.star.drawing.PolyPolygonBezierCoords")
REM Заливка в фактических координатах. Первая и последняя точки
REM - обычные точки, а средние точки - контрольные точки Безье.
'MsgBox oCoords.dbg_methods просмотп методов
MsgBox oCoords.dbg_properties

oCoords.Coordinates = Array(_
   Array(_
     CreatePoint( 1000, 1000 ),_
     CreatePoint( 3000, 4000 ),_
     CreatePoint( 3000, 4000 ),_
     CreatePoint( 5000, 1000 )_
   )_
 )
 oCoords.Flags = Array(_
   Array(_
     com.sun.star.drawing.PolygonFlags.NORMAL,_
     com.sun.star.drawing.PolygonFlags.CONTROL,_
     com.sun.star.drawing.PolygonFlags.CONTROL,_
     com.sun.star.drawing.PolygonFlags.NORMAL _
   )_
 )
oDoc = ThisComponent
oPage = createDrawPage(ThisComponent, "Test Draw", True)
oShape = oDoc.createInstance("com.sun.star.drawing.ClosedBezierShape")
oPage.add(oShape)
oShape.FillStyle = com.sun.star.drawing.FillStyle.GRADIENT
oShape.PolyPolygonBezier = oCoords
End Sub
у Питоньяка он работает, на ура. У него это группа макросов Draw, стр 566.
Выделил в свой модуль что бы поработать.
вот в этой строке: oCoords.Coordinates = Array(_
ругается на "Подпрограмма или функция не определена.", ведь тут объект который объявлен и правильно заполнен, в чём проблема подскажите

rami

Цитата: spyAndrey от 30 мая 2016, 21:34Выделил в свой модуль что бы поработать.
вот в этой строке: oCoords.Coordinates = Array(_
ругается на "Подпрограмма или функция не определена.", ведь тут объект который объявлен и правильно заполнен, в чём проблема подскажите
В макросе есть ссылка на две функции: CreatePoint() и createDrawPage(), а вы их не скопировали в модуль, ругается на их отсутствие.
Вот они:
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
  Dim oPoint
  oPoint = createUnoStruct("com.sun.star.awt.Point")
  oPoint.X = x : oPoint.Y = y
  CreatePoint = oPoint
End Function

Function createDrawPage(oDoc, sName$, bForceNew As boolean) As Variant
  Dim oPages 'Все рисованные страницы
  Dim oPage  'Одна рисованная страница
  Dim i%     'Основная индексная переменная
  oPages = oDoc.getDrawPages()
If oPages.hasByName(sName) Then
REM Если нам требуется новая страница, удалим страницу
If bForceNew Then
      oPages.remove(oPages.getByName(sName))
    Else
REM Не требуется новая страница, поэтому возвращаем найденную страницу REM и затем выходим из функции.
createDrawPage = oPages.getByName(sName)
Exit Function
End If
End If
  REM Не нашли страницу или нашли и удалили ее.
  REM Создаем новую страницу, задаем имя и возвращаем страницу.
  oPages.insertNewByIndex(oPages.getCount())
  oPage = oPages.getByIndex(oPages.getCount()-1)
  oPage.setName(sName)
  createDrawPage = oPage
End Function

spyAndrey

Да, эти функции, я тоже скопировал, но программа ругается именно на эту строку:
oCoords.Coordinates = Array(_

JohnSUN

После символа подчеркивания не должно быть пробела (а перед ним - лучше поставить)
Или удалить все символы подчеркивания в этом операторе - записать его в одну длинную строку без переносов
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

rami

Цитата: spyAndrey от 31 мая 2016, 13:33Да, эти функции, я тоже скопировал, но программа ругается именно на эту строку:
 oCoords.Coordinates = Array(_
Скопировал все три макроса из этой темы, запустил в Apache OpenOfficeLibreOffice запускал утром), работает без проблем.
Цитата: JohnSUN от 31 мая 2016, 13:55После символа подчеркивания не должно быть пробела (а перед ним - лучше поставить)
Или удалить все символы подчеркивания в этом операторе - записать его в одну длинную строку без переносов
При копировании из PDF нужно всё проверять, иногда такая фигня копируется :o...   , но насчёт пробелов, в Apache они не влияют (добавлял и до и после подчёркивания, хотя иногда замечал, что это влияет, не помню в каких офисах)

Если можно, выложите образец документа.

spyAndrey

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

spyAndrey

Думаю собака порывается вот в чём, предполагаю, что Питоньяк работает над документом с Windows, А я копирую Переношу и т.д. в Linux. Вот поэтому с кодировками и концом строки что то...
Решение пока ищу

spyAndrey

Попробовал копировать вставлять через буфер обмена в Windows версии офиса не а, не помогло.
И попытки в одну строку писать и "увидеть" неправильные переносы строки ничего не дали (
А помогло вот что, в редакторе макросов, панели инструментов "Макрос" есть две хорошие кнопки: "Сохранить BASIC" и "Вставить код на BASIC".
Вот этими кнопками можно вполне корректно перенести весь текст модуля, затем удалить не нужный код, ну а дальше обрабатывать напильником... )
Можно ставить статус темы Решено!

rami

Цитата: spyAndrey от 31 мая 2016, 16:21Думаю собака порывается вот в чём, предполагаю, что Питоньяк работает над документом с Windows, А я копирую Переношу и т.д. в Linux. Вот поэтому с кодировками и концом строки что то...
Питоньяк во многих местах писал, что работает и проверяет макросы и в Windows и в Linux. На Маке тоже проблем нет. Скорей всего это у вас "инцидент местного значения".

spyAndrey

Что бы быть до конца честным, все таки проблема была не в кодировках и концах строк, а в пропущенной функции, вот она:
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
  Dim oPoint
  oPoint = createUnoStruct( "com.sun.star.awt.Point" )
  oPoint.X = x : oPoint.Y = y
  CreatePoint = oPoint
End Function
Она используется при заполнении массива, вот на её отсутствие программа и ругалась... ;)

spyAndrey

Некоторое послесловие, то чего я добивался это вот этот код:
oCoords.Coordinates = Array(_
    Array(_
      CreatePoint( 1000, 1000 ),_
      CreatePoint( 2000, 1000 ),_
      CreatePoint( 2000, 1000 ),_
       CreatePoint( 2000, 2000 ),_
      CreatePoint( 2000, 5000 ),_
      CreatePoint( 2000, 6000 ),_
       CreatePoint( 2000, 6000 ),_
      CreatePoint( 1000, 6000 )_
    )_
  )
  oCoords.Flags = Array(_
    Array(_
      com.sun.star.drawing.PolygonFlags.NORMAL,_
      com.sun.star.drawing.PolygonFlags.CONTROL,_
      com.sun.star.drawing.PolygonFlags.CONTROL,_
      com.sun.star.drawing.PolygonFlags.NORMAL,_
      com.sun.star.drawing.PolygonFlags.NORMAL,_
      com.sun.star.drawing.PolygonFlags.CONTROL,_
      com.sun.star.drawing.PolygonFlags.CONTROL,_
      com.sun.star.drawing.PolygonFlags.NORMAL _
    )_
  )
Собственно от кода Питоньяка он не слишком отличается, вместо двух вершим в полигоне у меня их четыре.
Но, полистав его документы и немного интернет, приступил к научному тыку :) вот вывод:
(Не пинать если что опять пропустил в описаниях;) или математик не сильный)
у меня в полигоне пара прямых отрезков и пара с кривыми Безье, то что выяснил, это что между двух точек, где идёт кривая, должны быть ДВЕ точки которые нужны для вычисления кривой Безье.
соответственно крайние NORMAL, а внутренние две CONTROL.

rami

Цитата: spyAndrey от 31 мая 2016, 21:53
Что бы быть до конца честным, все таки проблема была не в кодировках и концах строк, а в пропущенной функции, вот она:
Function CreatePoint(ByVal x As Long,ByVal y As Long) As com.sun.star.awt.Point
  Dim oPoint
  oPoint = createUnoStruct( "com.sun.star.awt.Point" )
  oPoint.X = x : oPoint.Y = y
  CreatePoint = oPoint
End Function
Она используется при заполнении массива, вот на её отсутствие программа и ругалась... ;)

А кто-то весь день искал способ переноса макросов с помощью двух кнопок и напильника ;D

Цитата: rami от 31 мая 2016, 05:22В макросе есть ссылка на две функции: CreatePoint() и createDrawPage(), а вы их не скопировали в модуль, ругается на их отсутствие.
Цитата: spyAndrey от 31 мая 2016, 13:33Да, эти функции, я тоже скопировал, но программа ругается именно на эту строку:
 oCoords.Coordinates = Array(_

spyAndrey

Да, как говориться дело было не в бобине... ;D
Но благодаря кнопочкам и методу исключения, всё таки нашёл причину "глюка", но и кнопки полезны т.к. при переносах текстов особенно между ОС и кодировками исключается глюки связанные с кодировками, а они тоже бывают жестокими :'(