Stromové pakování (TreePacking)8.11.2025

Rychlý algoritmus řešící plnění kontejnerů položkami různé velikosti, zde 1D varianta vycházející z požadavku na minimalistické naplnění dokumentů LibreOffice různě dlouhými bloky textu tak, aby byl ušetřen papír při tisku viz. poradna LibreOffice. 3D varianta např. pro automatické plnění kamiónů či nákupních košíků je jen nakousnuta.

V případě tohoto algoritmu není nalezeno zcela optimální naplnění kontejnerů, ale je extra urychleno základní plnění kdy pokud se položka vejde tak je prostě zařazena a není nijak dále propočítáváno jestli třeba jinam či v jiné kombinaci by se mohla vejít lépe. Položky nejsou procházeny jedna po druhé a není žádné opakované tupé porovnávání vzájemné velikosti položek či míst v kontejnerech, ale je rovnou vybrána největší možná.

Pro dokument jsou brány tři druhy textových bloků, velké bloky které přesahují stránku, poloviční bloky delší než polovina stránky ale kratší než stránka, a krátké bloky kratší než polovina stránky.

A co když blok zabírá přesně polovinu stránky? Pak záleží na tom jestli mezi jednotlivými bloky je potřeba nějaký oddělovač (např. prázdný řádek) nebo jestli jsou vkládané čistě za sebe. Jde o to, že poloviční bloky by se neměly vejít dva na stránku.

Když jsem tento algoritmus uváděl do praxe, mezi bloky byla dávána čára z mínusů jako oddělovač, tudíž poté jako poloviční bloky byly brány ty, které měly větší velikost než byla velikost stránky snížená o velikost oddělovače a vydělená dvěmi = (výškaStránky – výškaOddělovače)/2, takže poloviční blok mohl být i o něco menší než polovina stránky.

Dále je potřeba rozhodnout jakým způsobem budou které bloky vypisovány, já praktikoval variantu kdy byly vypsané nejprve všechny dlouhé bloky, zbytek stránky po nich byl vyplněn krátkými a poté byl na začátek každé další stránky vypisován poloviční blok doplněný krátkými bloky. Pokud zbyly nějaké samotné poloviční bloky, byly přidané na konec dokumentu.

Jakési teoretizování nad tím, že by možná někdy mohl jeden půlblok vyjít hned po dlouhých apod. nemělo smysl rozvíjet, neb délky bloků v jednotlivých dokumentech byly různé přičemž dlouhé byly vzácné a nejvíce bylo krátkých, čili i osamnělé koncové půlboky byly spíše jen teoretická možnost. Krom toho jsem si říkal, že to už bych kdyžtak řešil ve variantě která by řešila úplně optimální rozložení.

Seřazení krátkých a polovičních bylo provedeno řazením polem. A pro vepisování bloků byla použita struktura pole polí, v podstatě taková větev byť i zde je to nazýváno strom s větvemi.

Strom pro stromové pakování

Velikost stránky je například 21 a bloky textů jsou vysoké: 10, 3, 12, 2, 22, 3, 2, 5, 8, 18, 17, 10, 2, 13, 2, 3

Dlouhé bloky (>21): 22

Poloviční bloky (>10,5 & <=21): 12, 18, 17, 13

Krátké bloky (<10,5): 10, 3, 2, 3, 2, 5, 8, 2, 2, 3

Základ stromu pro krátké bloky je poté takovýto:

První položka ve větvi je počet bloků dané velikosti, poslední položkou je pole s jednotlivými bloky textu (v dokumentu objekty s kopiemi jednotlivých bloků získané metodou .getTransferableForTextRange()).

Hlavní trik

Gró pro celý postup je: vepsat rovnou největší možný blok. Pro což se nabízí možnost kdy nyní nulové indexy jsou v kmeni nahrazeny ukazateli na nejbližší kratší větev, což eliminuje opakované tupé porovnávání jednotlivých velikostí bloků či místa v kontejnerech.

Použití stromu: Zjištěné prázdné místo na stránce je index ve stromu. Je-li index pole, jedná se o větev s vhodným blokem, je-li index číslo, vhodná větev je na pozici index+ukazatel.

Například na stránce je volné místo o velikosti 10, zkontroluj jaký typ je index na pozici 10. Jde o pole takže zapiš blok z této větve.

Nebo volné místo je 7 a tam je číslo -2, čili vhodný blok je na pozici 7–2=5.

Samozřejmě je tam podmínka pro místo delší než strom → je-li volné místo větší tak použij nejvyšší větev.

A bylo-li volné místo menší než nejmenší větev, tak bylo vloženo Zalomení Stránky namísto oddělovače.

Ukazatele však musí být změněny když dojde na vyprázdnění větve (dovypsání všech bloků z dané větve).

Například byla vyprázdněna větev 8, je tedy potřeba přeindexovat větve 8 a 9.

Ale co se stane když dále bude vyprázdněná větev 5? Je potřeba mít správně všechny indexy směrem k nejbližší vyšší větvi, čili znovu přepsat minimálně 8 i 9.

Tento postup tedy znamená opakované přepisování indexů jestliže se objeví sekvence prázdných větví, přičemž silnou nevýhodou může být když kmen bude z tisíce a více indexů, neboť velké množství opakovaně přepisovaných indexů již může zpomalit výpočet.

Je sice pravda že počítače jsou mnohem rychlejší než dříve, ale také je pravda, že ve většině programů je množství všelijak neoptimalizovaných svinčíků a výsledkem jsou pomalé aplikace na rychlých zařízeních. A opakování neoptimalizovaných operací je plýtvání.

Výška stránky v ODT dokumentech je brána v setinách milimetrů, tudíž velikost A4 je 29 700 a polovina pro krátké bloky je 14 850, což je velikost pole při které možná již bude poznat v LibreBasicu nějaké to zpomalení bylo-li by opakovaně přepisováno několik tisíc indexů.

Ukazatele ve větvích

Aby bylo eliminováno vícenásobné přepisování kmenových ukazatelů, je možné přidat do větví ukazatele na sousední větve. Každá větev je tedy rozšířena o ukazatel na sousední levou větev (0 znamená nemá souseda vlevo) a ukazatel na sousední pravou větev (0 znamená nemá souseda vpravo).

A může začít kombinatorické předpeklí. Co se stane jestliže nastane sekvence prázdných větví? Bude tam víc skoků přes prázdné větve.

Například byly vyprázdněné větve 5 a 8. A další prázdné místo je 9, což potřebuje skoky -1, -3, -2 aby byla vybrána nejbližší nejkratší větev 3.

Ale kdyby bylo prázdné místo 10 což je nejvyšší větev? Blok z větve 10 bude zapsán a větev vyprázdněna, ale nalezení nové největší větve 3 potřebuje skoky -2, -3, -2.

Otázka tedy je: Je možné redukovat počet skoků? Je, změněním ukazatelů ve vyprázdněné větvi.

Jednoduché měnění větvových ukazatelů

Kupříkladu byla vyprázdněna větev 5. Tudíž změnit indexy v sousedních větvích aby byla někdy déle přeskočena ona prázdná větev, což ale také nikdy nemusí nastat.

​Nový ukazatel v levé sousedce je počítán: původní pravý ukazatel z levé sousedky (2) plus pravý ukazatel z vyprazdňované větve (3) čili 2 + 3 = 5.

​Nový ukazatel v pravé sousedce: původní levý ukazatel z pravé sousedky (-3) plus levý ukazatel z vyprazdňované větve (-2) což je -3 -2 = -5.

Nějaké větvové ukazatele jsou sice změněné, ale může to být jen částečná výhra, neboť kombinatorické předpeklí může přejít do kombinatorického pekla → Ale vždyť by tam přeci mohlo být více skoků a to když další prázdné místo bude třeba tam nebo třeba onde anebo třebas …?

Ještě tedy příklad na další multiskoky, vyprázdněné větve budou 8 a poté 3.

private iMIN&, iMAX&, oDOC as object 'pro vykreslování v Calcu

Sub SledovatStrom 'strom s krátkými bloky
  on local error goto bug
  dim i&, pShort() as variant, iShort&, p(), iBlocks&, iCount&, iSpace&, num&, min&, max&
  const cVariant="Variant()" 'typ proměnné pro detekci větví ve stromu

  rem možnost dát krátké velikosti bloků do pShort
  pShort=array(2,3,5,8,10) 'krátké bloky

  iShort=ubound(pShort)
  iMIN=pShort(0) : iMAX=pShort(iShort)

  rem naplnit větve bloky
  dim index&, item as variant, pBranch()
  dim tree(iMIN to iMAX) as variant 'inicializovat pole pro strom
  min=iMIN : max=iMAX
  for each num in pShort
    index=num
    item=tree(index)
    if TypeName(item)=cVariant then 'přidat do stromu
      i=item(0)
      item(0)=i+1 'zvětšit počet bloků ve větvi
    else 'vytvořit větev ve stromu
      tree(index)=array(1, 0, 0) 'položky ve větvi: (0): počet bloků ve větvi; (1): nejbližší větev vlevo; (2): nejbližší větev vpravo
    end if
  next

  rem nastavit ukazatele ve stromu
  dim bNext as boolean, j&
  for i=lbound(tree) to ubound(tree) 'index ve stromu
    item=tree(i)
    if TypeName(item)<>cVariant then 'v tomto indexu není větev
      if NOT bNext then 'dát 0 do indexů < minimální větev
        tree(i)=0
      else 'nastavit ukazatel v kmeni na nejbližší kratší větev
        j=j-1
        tree(i)=j
      end if
    else 'index je větev
      if j<>0 then 'větve mají nějaké ukazatele mezi sebou
        j=j-1
        tree(i)(1)=j 'nastavit levý ukazatel aktuální větve na předchozí větev
        tree(i+j)(2)=Abs(j) 'nastavit pravý ukazatel v předchozí větvi na aktuální větev
      elseif bNext=true then 'větev je přesně za sousední větví (není žádný ukazatel mezi větvemi)
        tree(i)(1)=-1 'aktuální levý ukazatel
        tree(i-1)(2)=1 'pravý ukazatel předchozí větve
      end if
      bNext=true
      j=0
    end if
  next i

  rem simulace zápisu bloků
  dim branch(), branch2(), iLeft&, iRight&, bBreak as boolean, iPage&, iPointerR&, iPointerL&
  iBlocks=ubound(pShort) 'počet bloků
  j=2*iCount
  while iBlocks>-1
    tree2calc(tree) 'vykreslit strom v Calcu
    iSpace=CLng(inputbox("Empty space (block size to ""write"")")) 'zadat prázdné místo
    if iSpace=0 then exit sub 'není prázdné místo iSpace
    if iSpace<min then exit sub 'příliš malé prázdné místo
    if iSpace>max then iSpace=max 'volmé místo je větší než nejvyšší větev, použít nejvyšší větev
    item=tree(iSpace) 'ukazatel nebo větev ve stromu
    if TypeName(item)=cVariant then 'položka v kmeni je větev
      branch=item
      index=iSpace
    else 'položka je číslo takže ukazatel
      index=iSpace+item
      branch=tree(index) 'nejbližší kratší větev
    end if
    rem získat bloky
    i=branch(0) 'počet bloků ve větvi
    while i=0 'prázdná větev tak (multi)skok na nejbližší neprázdnou levou větev
      index=index+branch(1)
      branch=tree(index)
      i=branch(0) 'počet bloků ve větvi
      wend
      i=i-1 'poslední blok ve větvi
      rem v originálu je zde vložení bloku do dokumentu
      iBlocks=iBlocks-1 'block is pasted

      rem modifikace "dotčených" větví
      j=j+1
      branch(0)=i 'snížit počet bloků ve větvi
      if i=0 then 'byl to poslední blok z větve
        if index=max then 'je to poslední větev
          p=findNearestBranch(tree, index, true) 'nejbližší neprázdná levá větev
          branch2=p(0) 'nová nejvyší větev
          index=p(1)
          max=index 'nové maximum
        elseif index=min then 'jde o první větev
          p=findNearestBranch(tree, index, false) 'nejbližší neprázdná pravá větev
          branch2=p(0) 'nová nejnižší větev
          index=p(1)
          min=index 'nové minimum
        else 'jde o prostřední větev
          rem nastavit ukazatel v pravé větvi
          iRight=branch(2) 'ukazatel na nejbližší pravou větev
          branch2=tree(index+iRight) 'pravá větev
          iPointerR=branch2(1) + branch(1)
          branch2(1)=iPointerR 'změnit levý ukazatel v pravé větvi
          rem nastavit ukazatel v levé větvi
          iLeft=branch(1) 'ukazatel na nejbližší levou větev
          branch2=tree(index+iLeft) 'levá větev
          iPointerL=branch2(2) + branch(2)
          branch2(2)=iPointerL 'změnit pravý ukazatel v levé větvi
        end if
      end if
      wend
      tree2calc(tree) 'poslední vykreslení stromu
      exit sub
bug:
      msgbox(Err & chr(13) & "line: " & Erl & chr(13) & Error, "WatchTree")
End Sub

Sub bug(sFce$) 'chybová zpráva
      msgbox(Err & ": " & Error & chr(13) & "Line: " & Erl, 16, sFce)
      stop
End Sub

Function findNearestBranch(tree(), ByVal index&, bLeft as boolean) as array 'najít nejbližší větev; bLeft je pro levou větev jinak pravou
      on local error goto bug
      dim branch(), iPointer&, iLeft%, iLeft2%
      iLeft=iif(bLeft, 1, 2)
      branch=tree(index)
      do
        iPointer=branch(iLeft) 'ukazatel na další větev
        index=index+iPointer
        branch=tree(index) 'předpokládaná nová větev
      loop while branch(0)=-1 'prázdná větev takže testni další větev
      iLeft2=iif(bLeft, 2, 1)
      branch(iLeft2)=0 'nová minimální nebo maximální větev
      findNearestBranch=array(branch, index)
      exit function
bug:
      bug("findNearestBranch")
End Function

Sub tree2calc(tree as object) 'ukázat aktuální strom v Calcu
      on local error goto bug
      const cVariant="Variant()"
      dim oSheet as object, i&, j&, oCur as object, oRange as object, oCell as object, ibound&, oBorder as new com.sun.star.table.BorderLine, cGrey&, item as variant
      cGrey=RGB(150, 150, 150)
      if isNull(oDOC) then
        oDOC=Stardesktop.loadComponentFromUrl("private:factory/scalc", "_blank", 0, array())
        oSheet=oDOC.Sheets(0)
        with oBorder
          .OuterLineWidth=50
          .Color=cGrey
        end with
        ibound=lbound(tree)
        for i=ibound to ubound(tree) 'šedé rámečky pro kmen
          j=i-ibound+1
          oCell=oSheet.getCellByPosition(j, 1) 'indexy v kmeni
          with oCell
            .BottomBorder=oBorder
            .TopBorder=oBorder
            .RightBorder=oBorder
            .LeftBorder=oBorder
          end with
        next i
      end if
      oSheet=oDOC.Sheets(0)
      oCur=oSheet.createCursor
      oCur.goToEndOfUsedArea(false)
      oRange=oSheet.getCellRangeByPosition(0, 0, oCur.RangeAddress.EndColumn, 0)
      oRange.clearContents(5) 'jako v herní smyčce -> smazat všechno a vykreslit to znovu
      ibound=lbound(tree)
      for i=ibound to ubound(tree)
        j=i-ibound+1
        oCell=oSheet.getCellByPosition(j, 1) 'indexy v kmeni
        with oCell
          .String=i
          .CharColor=cGrey
        end with
        item=tree(i)
        if TypeName(item)<>cVariant then 'ukazatele v kmeni
          oCell=oSheet.getCellByPosition(j, 1)
          oCur=oCell.createTextCursor
          with oCur
            .gotoEnd(false)
            .CharColor=RGB(254, 57, 189) 'růžová
            .CharWeight=com.sun.star.awt.FontWeight.BOLD
            .String=" " & item
          end with
        else 'větev
          oCell=oSheet.getCellByPosition(j, 2) 'počet bloků ve větvi
          with oCell
            .ParaAdjust=3
            .CharColor=RGB(0, 123, 1) 'tmavě zelená
            .CharWeight=com.sun.star.awt.FontWeight.BOLD
            .String=item(0)
          end with
          oCell=oSheet.getCellByPosition(j, 3) 'ukazatel vlevo
          with oCell
            .ParaAdjust=3
            .CharColor=RGB(255, 138, 23) 'oranžová
            .CharWeight=com.sun.star.awt.FontWeight.BOLD
            .String=item(1)
          end with
          oCell=oSheet.getCellByPosition(j, 4) 'ukazatel vpravo
          with oCell
            .ParaAdjust=3
            .CharColor=RGB(105, 131, 133) 'šeděmodrá
            .CharWeight=com.sun.star.awt.FontWeight.BOLD
            .String=item(2)
          end with
          oCell=oSheet.getCellByPosition(j, 5) '"bloky" ve větvích
          oCell.CellBackColor=iif(item(0)>0, RGB(102, 204, 255), -1) 'světlemodrá nebo průhledná
        end if
      next i
      exit sub
bug:
      bug("tree2calc")
End Sub

Zpět k původnímu kombipeklíčku.

A když teď bude volné místo 9? Pak by byly potřeba skoky -1, -5, -1 na větev 2.

A kdyby prázdné místo bylo 10? pak nalezení nové nejvyšší větve 2 je skokem -8.

Je možné redukovat multiskoky? Asi jo, ale vypadá to až příliš komplikovaně a zbytečně. Jediné alespoň drobet obhájitelné řešení které mě napadá by bylo změnit ukazatele během multiskoku, ale znamenalo by to pamatovat si všechny skákané větve a všem změnit ukazatele, což značí nějaké zpomalení které však pro nějaká běžná data nejspíš nebude znatelné.

Mělo by to však smysl? Myslím si že ne, strom je jen pro krátké větve a je možná větší šance že delší větve se budou dříve zkracovat a kratší též ubývat než že by byly vyprazdňovány jen prostřední větve a vznikaly tak nějaké dlouhé sekvence prázdných větví mezi nejdelšími a nejkratšími větvemi a přitom vyvstávaly samé prostřední mezery ze kterých by se skákalo na kratší větve.

A je úplně zbytečné vymýšlet jakási neexistující matematické pseudosituace typu: Nechť větve jsou takové a onaké a všelijak divné, a prázdná místa jinaká a dozaujatě onakle máklá, a kontejnery jakbysmet navíc dodávané v jakémsi echtmagoricky vyblouzněném pořadí, a k tomu ... ! neboť následná pseudořešení postavená na takovýchto (nechť si to v hlavě představíš tak‐a‐tak a na tom prý stojí pravda) výmyslech které přežívají jen v jakýchsi chorých memorizátorech a nikdy nepomohly rozhodně nic nezjednodušší, jen bezsmyslně zesložiťují (asi jako celá matematika).

Skoky ve statických polích by měly být rychlé, tudíž zpomalení pro milióny skoků by mohlo být maximálně v sekundách, přičemž je jisté, že zjišťování velikostí bloků a vykreslování je mnohem pomalejší než výpočty se skoky. A jistě nechcete prohazovat takové množství bloků v nějakém nelidském dokumentu :-).

2D a 3D struktury

Nemělo by být složité udělat si tři větve pro jednotlivé prostory (x, y, z) ve 3D a prostě vzít volné místo v x, k němu volné v y a k němu volné v z a předmět vložit. Byť zase už to pro někoho mohou být stěží představitelné struktury i to jak mezi těmi třemi větvemi nalinkovat jednotlivé bedýnky.

Specifika pro LibreOffice

Pomalá pole v LibreBasicu

LibreBasic skutečně není nejrychlejším jazykem pro operace s poli → kvůli čemuž jsem v makrech použil mnohem statičtější než dynamičtější pole, neboť užití ReDim preserve pro převelikostnění pole při změně každé položky je příliš pomalé pro tisíce položek. Tudíž jsou předdefinované výchozí velikosti polí (globální proměnná iREDIM) a podmínka pro zvětšení pole když již nestačí, což je mnohem rychlejší. Plnění pole jednoduchým příkazem typu pole(i)=něco je prováděno skrze funkci extendArray.

Pole se zkopírovanými informacemi (.getTransferableForTextRange()) o jednotlivých blocích (index (3) ve větvi) s předdefinovanými velikostmi jsou poté zhruba takto:
arr(0)=object1
arr(1)=object2
arr(2)=Empty
arr(3)=Empty
'… atd.

Zákeřnosti v dokumentech

Přepínané .lockControllers() a ComponentWindow.Visible

oDoc.lockControllers() nejde použít pro detekci velikostí bloků, neboť to vypíná výpočet pozice viditelného kurzoru (oVCur.Position.Y). Vykreslování je nejpomalejší, ale je možné notné zrychlení pomocí .lockControllers() když nebude propočítávána pozice oVCur. Pouze velké bloky a koncové poloviční bloky potřebují zjišťovat zbývající místo na stránce, takže pro tyto případy je okno dokumentu schováváno alespoň s CurrentController.ComponentWindow.Visible=false což vykreslování také urychlí i když zdaleka ne tolik jako .lockControllers().

Před vykreslením je nejprve spočítáno rozmístění běžných půlbloků a krátkých bloků do stránek (fce fillContainer a pole pContainers()), po čemž mohou být bloky zapisovány již s lockControllers() což je tedy mnohem rychlejší než neustálé zjišťování prázdného místa na stránce po každém zapsaném bloku pomocí oVCur.Position.Y.

Není se tedy potřeba obávat nějakého toho problikávání dokumentu při zpracovávání.

Úskalí při zjišťování velikostí bloků

Bylo to komplikované a nevím jestli jsem objevil všechny záludnosti, pro nějaké další použití je potřeba dobré testování.

Mezera mezi stránkami

Writer vykresluje stránky tak, že mezi nimi nechává mezeru ve které se zobrazuje případné Zalomení stránky. Šířka této mezery se však započítává do pozice viditelného kurzoru, je tedy proveden výpočet pro velikost této mezery.

Horní okraj odstavce na začátku bloku

Ten dělá problém, protože pozice kurzoru je nějak propočítávána s tímto okrajem, ale při Copy&Paste tento okraj může zmizet. Nezkoumal jsem přesně jak se to chová, tudíž makro prostě odstraní tyto Horní okraje pro všechny odstavce v oDoc.Text.

Horní a spodní okraj oddělovače

V realizovaném případě byla oddělovačem čára z mínusů a byl v ní vynulován horní i spodní okraj. Konstantou iDASHEDHEIGHT se mění velikost fontu pro mínusy a makro dopočítává počet mínusů aby nepřesáhly jeden řádek.

Volba Spojit s následujícím odstavcem

Ta dělá že se odstavec či tabulka mnohdy posune na další stránku neb na aktuální není pro tak dlouhý blok místo. Pro zjištění velikosti bloků makro odstraní tuto vlastnost z odstavců i tabulek a před každý blok vloží Zalomení stránky aby začínal na začátku stránky.

Tato operace však není vykreslována, neb Zalomení jsou vkládána při .lockControllers() a velikosti bloků zjišťovány při ComponentWindow.Visible=false.

Malá mezera pod tabulkou která přesune viditelný kurzor na začátek nové stránky.

Ale je dostatečně velká aby se do ní vtěsnal první řádek z následujícího bloku, protože ten následující řádek má menší velikost písma než viditelný kurzor.

Je problematické detekovat přesnou velikost takovýchto bloků, byť by se kurzoru dala nastavit velikost písma 1px a pak by se většinou do té malé mezery již vešel, avšak toto se týká jen půlbloků zabírajících v podstatě celou stránku a jelikož tedy není žádný další blok který by se do stránky vešel, je úplně jedno jestli má takový celoblok spočítanou velikost přesně na pixel či nikoliv.

Tahle malá mezera však dokáže způsobit to, že se na konci dokumentu může objevit zbytečná prázdná stránka, která by se stala nejspíš otravnou při tisku. To je dáno tím že po tabulce musí být odstavec a ten má tedy nějakou výšku, která může být větší než mezera.

Pokud tedy na toto dojde, makro sníží velikost posledního řádku na 1px (což ale nejde nastavit ručně neb nejmenší ruční velikost lze dát 2, tak doufám že to nebude dělat problémy) a pokud se ani takto zmenšený řádek nevejde pod tabulku na předchozí stránku, makro zkusí dát horní a spodní okraj v prvním řádku tabulky na nulu (neb přeci jen tyto okraje v textu v tabulkách nějaké byly). A pokud i tak zůstane poslední prázdná stránka, vypíše se alespoň upozorňující hláška.

Tabulka rozdělená na dvě stránky

Znamená že oVCur.Position.Y bude opět o něco větší, ovšem jelikož se to týká jen velkých bloků tak jsem velikost těch malých mezer nezjišťoval.

Zalomení stránky někdy potřebuje alespoň jeden znak na prvním řádku stránky jinak se nevloží

To je řešeno vkládání Nulových mezer U+200B (&h200B&) na začátek každého bloku začínajícího na začátku stránky. Prostě vložit nulovou mezeru s malou velikostí písma, po ní Zalomení stránky a pak již blok.

Závažná chyba

Raději jsem kontroloval počet tabulek, neb blok se skládal z nějakého textu v hlavičce a následné tabulky. A samozřejmě by nemělo být dopuštěno aby byl nějaký blok vynechán.

Uvedená hláška informující že jsem někde udělal chybu se mi naštěstí neobjevila mnohokrát, byť nevím zda-li jsem objevil všechny záludnosti nebo praxe ukáže ještě nějaký problém.

Snažší debugování

Zpočátku to bylo krokování programu než jsem vychytal záludnosti, tudíž jsem si to usnadnil tím, že jsem přidal možnost aby se očíslovaly oddělující čáry z mínusů, neboť neustálé rolování myší a počítání tabulek a řádků bylo dost unavující.

Makro

Je možné si zkopírovat do maker kód níže a spustit makro ReducePages, které otevře dialog pro výběr souboru kde vybrat stažený prohazet-bloky.odt35kB. Makro vytvoří kopii tohoto souboru a zpřehází v něm bloky textu.

option explicit
rem testováno v LibreOffice 25.2.3.2 Win10x64 2025.5
rem pro jistotu jsou zapsány ByRef pro proměnné měněné uvnitř funkcí!

rem reguláry pro označení bloků, blocky musí být v normálním textu a nikoliv tabulkách apod.
private const sBLOCKSTART="IN THE COURT OF" 'začátek bloku
private const sBLOCKEND="^-+$" 'konec bloku (Čárkovaná čára z mínusů)

rem přípona pro zredukovaný dokument
private const sRENAME="-REDUCED" 'přípona pro nový dokument po redukci počtu stránek např.: muj-dokument-REDUCED.odt

rem výchozí adresář pro výběr souboru na začátku makra
private const sINITDIR="" 'např. d:\documents or file:///home/user

rem praxe ukázala že výška Čárkované čáry může redukovat stránky navíc, tudíž jsem její výšku snížil na 9 (z 12)
private const iDASHEDHEIGHT=9 'výška Čárkované čáry
private const sDASHEDFONT="Liberation Serif" 'výchozí font pro Čárkovanou čáru, aby všechny měly opravdu stejnou výšku
private const iSOLITARY=3 'násobek iDASHEDHEIGHT pro minimální místo po osamnělém půlbloku kam může být vložena a rozpojena další část hlavičky IN THE COURT OF


rem konstanty makra
private const DEBUG=false 'true: přidá číslo před Čárkovanou čáru (pro snažší debuging)
private iNO& 'číslo před Čárkovanou čárou během debugování (je pouze v: Sub pasteDashedLine, pasteDashedLine2)

rem proměnné nastavované v getGlobals()
private oDASHED as object 'objekt s Čárkovanou čárou pro .insertTransferable
private iDASHED& 'velikost čárkované čáry v 1/100mm
private iHEIGHT&  'velikost stránky v 1/100mm
private iHEIGHTED& 'velikost stránky bez horního a spodního okraje 1/100mm
private iGAP& 'mezera mezi stránkami 1/100mm
private iHALFED& ' "polovina" stránky 1/100mm

rem proměnné nastavované v getBlocks()
private iMIN& 'skutečná nejkratší velikost z krátkých bloků
private iMAX& 'skutečná největší velikost z krátkých bloků
private iMINHALF&, iMAXHALF& 'minimální and maximální velikost půlblocků

private const iREDIM=50 'pro ReDim Preserve aby to nekolabovalo na příliš malých polích (výchozně 50; pro tisíce bloků může být 100 a víc)

private iCONT& 'počet kontejnerů (stránek)
private iSAFE& 'počet tabulek (pro kontrolu že je ve vybraném a zredukovaném dokumentu stejný počet tabulek)
rem řetězcové konstanty (většinou pro rychlejší operace s řetězci)
private const sNULL="", sMINUS="-", sPAGESTYLES="PageStyles", sVARIANT="Variant()" 'typ proměnné pro detekci větví ve stromu

Sub ReducePages 'proházet bloky textu pro zredukování počtu stránek
	on local error goto bug
	const cStep=30 'počet bloků pro aktualizaci ukazatele průběhu ve stavovém řádku
	dim oDoc as object, oCur as object, oVCur as object, oStatusbar as object, oFound as object, i&, pBig() as variant, iBig&, pHalf(), iHalf&, pShort() as variant, iShort&, p(), _
		oBlock as object, iBlocks&, iTables&, iCount&, data as object, arr(), iSpace&, sUrl$, sUrlNew$, undoMgr as object, iPages0&, iPagesBig&, ibound&, iContainer&, _
		pContainers(iREDIM) as variant, pp(), branch(), ii&, iProgress&, iContainers&

	rem vytvořit kopii dokumentu
	sUrl=chooseFile(sINITDIR)
	sUrlNew=Mid(sUrl, 1, Len(sUrl)-4) & sRENAME & ".odt" 'přidat -REDUCED.odt do url doumentu
	FileCopy(sUrl, sUrlNew)
	oDoc=StarDesktop.loadComponentFromURL(sUrlNew, "_blank", 0, array()) 'otevřít ...-REDUCED.odt

	iPages0=oDoc.CurrentController.PageCount 'zapamatovat výchozí počet stránek
	undoMgr=oDoc.UndoManager
	undoMgr.lock
	iCount=oDoc.TextTables.Count 'předpokládaný počet bloků je počet tabulek, také jako maximum pro ukazatel průběhu
	iSAFE=iCount 'počet tabulek v originálním dokumentu (pro kontrolu)
	oStatusbar=oDoc.CurrentController.StatusIndicator 'ukazatel průběhu
	with oStatusbar 'inicializace ukazatele průběhu
		.start(sNULL, 3*iCount)
		.setValue(0)
	end with
	oCur=oDoc.Text.createTextCursor
	oVCur=oDoc.CurrentController.ViewCursor
	with oDoc.CurrentController.Frame
		.ComponentWindow.Visible=false 'viditelný kurzor musí být aktivní (nedodává Position.Y při oDoc.lockControllers)
		.ContainerWindow.toFront 'dokument raději na popředí (někdy je problematické spouštět makro z Basic editoru když má v dokumentu skákat viditelný kurzor)
	end with

	getGlobals(oDoc, sBLOCKEND) 'nastavit část globálních proměnných
	oDoc.lockControllers
	removeKeepTogether(oDoc) 'odebrat vlastnost "Svázat s následujícím odstavcem"
	p=getBlocks(oDoc, sBLOCKSTART, sBLOCKEND, oStatusbar, iCount, cStep) 'dostat bloky a zbytek globálních proměnných

	pBig=p(0) 'bloky delší než stránka
	iBig=ubound(pBig) 'počet velkých bloků
	pHalf=p(1) 'půlbloky
	iHalf=ubound(pHalf) 'počet půlbloků
	if iHalf>-1 then sortHalfBlocks(pHalf)
	pShort=p(2) 'krátké bloky
	iShort=ubound(pShort) 'počet krátkých

	rem vyplnit větve krátkými bloky
	if iShort>-1 then 'jsou krátké bloky tak vytvořit strom
		dim index&, item as variant, min&, max&, pBranch()
		dim tree(iMIN to iMAX) as variant 'inicializace pole pro kmen stromu
		min=iMIN : max=iMAX
		for each arr in pShort 'jednotlivé subpole z pole krátkých bloků
			index=arr(0)
			item=tree(index)
			if TypeName(item)=sVARIANT then 'jde o větev stromu
				i=item(0)
				ii=i+1
				item(0)=ii 'zvýšit počet bloků ve větvi (tento počet je pro plnění kontejnerů)
				pBranch=item(3) 'pole s bloky ve větvi (.getTransferableForTewxtRange())
				ibound=ubound(pBranch)
				if i>ibound then 'větev je již plná bloků tak zvěti její pole
					redim preserve pBranch(ibound+iREDIM) 'zvětšit pole ve větvi
					item(3)=pBranch
				end if
				item(3)(i)=arr(1) 'přidat blok do větve
			else 'vytvořit větev ve stromě
				redim p(iREDIM)
				p(0)=arr(1)
				tree(index)=array(1, 0, 0, p) 'indexy ve větvi:
					'(0): počet bloků ve větvi
					'(1): ukazatel na větev vlevo
					'(2): ukazatel na větev vpravo
					'(3): pole s .getTransferable() of bloků
			end if
		next

		rem nastavit ukazatele v kmeni a větve ve stromu
		dim bNext as boolean, j&
		for i=lbound(tree) to ubound(tree) 'index v kmeni
			item=tree(i)
			if TypeName(item)<>sVARIANT then 'na tomto indexu nejde o větev
				if NOT bNext then 'dát 0 na indexy menší než minimální větev
					tree(i)=0
				else 'nastavit ukazatel v kmeni na nejbližší nejkratší větev
					j=j-1
					tree(i)=j
				end if
			else 'index je větev
				if j<>0 then 'větve mají mezi sebou nějaké ukazatele
					j=j-1
					tree(i)(1)=j 'nastavit levý ukazatel v aktuální větvi na předchozího souseda
					tree(i+j)(2)=Abs(j) 'nastavit pravý ukazatel v předchozí větvi na aktuální větev
				elseif bNext=true then 'větev je přesně za sousední větví (není mezi nimi index s ukazatelem)
					tree(i)(1)=-1 'aktuální ukazatel vlevo
					tree(i-1)(2)=1 'předchozí větve pravý ukazatel
				end if
				bNext=true
				j=0
			end if
		next i
	else 'žádné krátké bloky
		iMIN=iHALFED
	end if

	rem zapsat velké bloky do dokumentu
	oDoc.unlockControllers
	dim bHalf as boolean
	ibound=ubound(pBig)
	for i=lbound(pBig) to ibound
		data=pBig(i)(1) 'data bloku
		pasteBlock(oDoc, oCur, data)
		if i<ibound then 'není to poslední velký blok
			bHalf=pasteDashedLine(oDoc, iMIN, oCur, oVCur) 'bylo tam Zalomení stránky
		else 'poslední velký blok
			if iShort<>-1 AND iHalf<>-1 then bHalf=pasteDashedLine(oDoc, iMIN, oCur, oVCur) 'je tam poloviční nebo krátký blok
		end if
	next i
	iPagesBig=oDoc.CurrentController.PageCount 'zapamatovat stránku s koncem posledního velkého bloku

	if iShort<>-1 then 'jsou krátké bloky
		rem naplnit kontejnery - to je výpočet pro každou stránku aby bylo možné rychlé vykreslování při .lockControllers() místo pomalého oVCur.Position.Y po každém bloku
		iSpace=getSpace(oDoc, oVCur) 'zbývající prázdné místo na stránce
		oDoc.lockControllers
		if iShort>-1 AND iSpace>=iMIN then iContainer=iSpace 'je tam nějaké místo po velkých blocích
		iBlocks=ubound(pShort) 'počet krátkých bloků
		if iSpace<iHEIGHTED then fillContainer(pContainers(), tree(), iBlocks, min, max, -1, pHalf, iSpace) 'doplnit krátkými bloky
		while iBlocks>-1 'spočítat normální stránky s půl a krátkými bloky
			fillContainer(pContainers(), tree(), iBlocks, min, max, iHalf, pHalf(), iHEIGHTED)
		wend
		redim preserve pContainers(iCONT-1)

		rem zapsat krátké a půlbloky z pole pContainers()
		iProgress=2*iCount 'pro ukazatel průběhu
		iContainers=ubound(pContainers)
		for i=lbound(pContainers) to iContainers
			iProgress=iProgress+1
			if iProgress MOD cStep=0 then oStatusbar.setValue(iProgress)
			p=pContainers(i) 'indexy ve stromě s bloky do aktuální stránky
			ibound=ubound(p)
			for j=lbound(p) to ibound
				pp=p(j)
				iHalf=pp(0)
				iShort=pp(1)
				if iHalf<>-1 then 'zapsat půlblok
					pasteBlockHalf(oDoc, pHalf, iHalf, oCur)
					if iShort<>-1 then pasteDashedLine2(oDoc, oCur) 'půlblok není samostný na stránce tak přidat Čárkovanou čáru
				end if
				if iShort<>-1 then 'zapsat krátký blok
					branch=tree(iShort)
					iCount=branch(0) 'který blok zapsat
					data=branch(3)(iCount) '.getTransferable()
					pasteBlock(oDoc, oCur, data)
					tree(iShort)(0)=iCount+1 'přístě zapsat blok s vyšším indexem
					if j<ibound then pasteDashedLine2(oDoc, oCur) 'nejde o poslední blok tak přidat Čárkovanou čáru
				end if
			next j
			if i<iContainers then insertPageBreak(oCur) 'nejde o poslední kontejner takže vložit Zalomení stránky
		next i
	end if

	rem zapsat zbylé osamnělé půlbloky (budou rozpojovány přes stránky)
	dim s$, s1$, iSplitted&
	if iHalf>-1 then
		iSplitted=oDoc.CurrentController.PageCount 'stránka s 1. zbývajícím půlblokem
		s=chr(13) & chr(13) & "Solitary half blocks: " & iHalf & chr(13) 'počet osamnělých půlbloků
		s1=chr(13) & "from page: " & iSplitted
		if oDoc.hasControllersLocked then oDoc.unlockControllers 'musí být počítáno prázdné místo pro Čárkovanou čáru
		s=s & "SPLITTED" & s1 'info o osamnělých půlblocích
		iSpace=iDASHED*iSOLITARY 'minimální místo pro řádek hlavičky IN THE COURT OF
		while iHalf>-1 'zapsat bloky
			pasteDashedLine(oDoc, iSpace, oCur, oVCur)
			pasteBlockHalf(oDoc, pHalf, iHalf, oCur) 'vložit půlblok
		wend
	end if

	rem smazat poslední prázdnou stránku (vyskytla-li se)
	dim iPages&, iPages2&
	if oDoc.hasControllersLocked then oDoc.unlockControllers
	with oVCur
		.jumpToLastPage
		.jumpToStartOfPage
	end with
	if isEmpty(oVCur.Cell) then 'viditelný kurzor není v tabulce
		with oCur
			.gotoRange(oVCur.Start, false)
			.gotoEnd(true)
		end with
		if oCur.String=sNULL then 'poslední stránka je prázdná
			iPages=oDoc.CurrentController.PageCount 'aktuální počet stránek
			with oVCur 'snížit velikost fontu aby kurzor snad skočil pod tabulku na předchozí stránce
				.String=chr(&h200B&) 'nulová mezera
				.CharHeight=1 'není možné nastavit manuálně neb minimální manuální jde 2
				.CharHeightAsian=1
				.CharHeightComplex=1
				.gotoRange(oCur.End, false)
			end with
			if oDoc.CurrentController.PageCount=iPages then 'poslední stránka nebyla eliminována
				with oVCur
					.jumpToLastPage
					.jumpToPreviousPage
					.jumpToEndOfPage
				end with
				if NOT isEmpty(oVCur.Cell) then 'viditelný kurzor je v poslední tabulce
					dim oTable as object, oCell as object, oCursor as object
					oTable=oVCur.TextTable
					for i=0 to oTable.Columns.Count-1 'žádný horní a spodní okraj pro odstavce v prvním řádku tabulky
						oCell=oTable.getCellByPosition(i, 0)
						oCursor=oCell.createTextCursor
						with oCursor
							.gotoStart(false)
							.gotoEnd(true)
							.ParaTopMargin=0
							.ParaBottomMargin=0
						end with
					next i
				end if
			end if
		end if
	end if

	rem ukázat statistiku
	removeLock(oDoc)
	iPages2=oDoc.CurrentController.PageCount 'aktuální počet stránek
	i=iPages0 - iPages2 'počet ušetřených stránek
	s="Saved pages: " & i + iif(iPages2=iPages, 1, 0) & iif(iBig=-1, sNULL, chr(13) & "Big blocks end in page: " & iPagesBig) & s
	iCount=oDoc.TextTables.Count 'počet vložených tabulek
	if iCount<>iSAFE then problem(oDoc, "MISSING TABLES: " & iSAFE-iCount, 16)
	if iPages2=iPages then 'bohužel zůstala poslední prázdná stránka (a nepředpokládám že je potřeba nějaké složitější snaha jak ji smazat)
		s=s & chr(13) & chr(13) & "LAST PAGE IS EMPTY"
		with oVCur
			.jumpToLastPage
			.jumpToPreviousPage
			.jumpToStartOfPage
		end with
	elseif iBig>-1 then 'nějaké velké bloky byly tak skočit na stránku kde končí poslední z nich
		with oVCur
			.jumpToPage(iPagesBig)
			.jumpToStartOfPage
		end with
		while NOT isEmpty(oVCur.Cell) 'viditelný kurzor pod poslední velký blok
			oVCur.goDown(1, false)
		wend
	elseif iSplitted>0 then 'osamnělé půlbloky tak viditelný kurzor na jejich začátek
		with oVCur
			.jumpToPage(iSplitted)
			.jumpToEndOfPage
		end with
	end if
	msgbox(s, iif(i<0, 48, 0))

	exit sub
bug:
	removeLock(oDoc)
	bug("ReducePages")
End Sub

Sub bug(sFce$) 'chybové hlášení
	msgbox(Err & ": " & Error & chr(13) & "Line: " & Erl, 16, sFce)
	stop
End Sub

Function chooseFile(optional sInitDir$) as string 'dialog pro výběr soubor ve výchozím adresáři
	dim oFileDlg as object, oFileAccess as object, oFiles as object, sFile$
	oFileDlg=CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
	with oFileDlg 'filtr souorů v dialogu
		.AppendFilter("All files (*.*)", "*.*")
		.AppendFilter("Writer (*.odt)", "*.odt")
		.SetCurrentFilter("Writer (*.odt)") 'výchozí soubor ve filtru
	end with
	oFileAccess=CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
	with oFileDlg
		.MultiSelectionMode=false
		.SetDisplayDirectory(ConvertToUrl(sInitDir))
	end with
	if oFileDlg.execute() then 'dialog pro výběr souboru
		oFiles=oFileDlg.getFiles()
		sFile=oFiles(0)
	end if
	if sFile="" then stop 'soubor nebyl vybrán
	chooseFile=sFile
End Function

Function deleteDocument(oDoc as object) 'smazat obsah dokumentu
	on local error goto bug
	dim oCur as object, oVCur as object
	oVCur=oDoc.CurrentController.ViewCursor
	oCur=oDoc.Text.createTextCursor
	with oCur
		.gotoStart(false)
		.gotoEnd(true)
		.String=sNULL
		.setAllPropertiesToDefault
		.ParaAdjust=3 'zarovnání na střed
	end with
	exit function
bug:
	bug("deleteDocument")
End Function

Function extendArray(p(), index&) 'zvětšit příliš malé pole
	on local error goto bug
	dim ibound&
	ibound=ubound(p) 'délka pole
	if index>ibound then 'nový index v poli
		redim preserve p(index + iREDIM) 'zvětšit pole
	end if
	exit function
bug:
	bug("extendArray")
End Function

Function fillContainer(pContainers(), tree(), ByRef iBlocks&, ByRef min&, ByRef max&, ByRef iHalf&, pHalf(), ByVal iSpace0&) 'naplnit kontejner
	on local error goto bug
	dim pCont(iREDIM) as variant, i&, branch(), branch2(), iLeft&, iRight&, bBreak as boolean, iPage&, iPointerR&, iPointerL&, bHalf as boolean, item as variant, index&, iSpace&, _
		iCount&, ibound&, p()
	bHalf=iif(iHalf<>-1, true, false) 'půlblok
	if bHalf then 'půlblok existuje
		iSpace0=iSpace0 - iDASHED - pHalf(iHalf)(0) 'prázdné místo po půlbloku
		iHalf=iHalf-1
	end if
	while iBlocks>-1 AND iSpace0>=min
		iSpace=iSpace0
		if iSpace>max then iSpace=max 'prázdné místo je větší než největší větev tak použít největší větev
		item=tree(iSpace) 'ukazatel nebo větev ve stromu
		if TypeName(item)=sVARIANT then 'položka je větev
			branch=item
			index=iSpace
		else 'položka je číslo čili ukazatel
			index=iSpace+item
			branch=tree(index) 'nejbližší kratší větev
		end if
		rem dostat bloky
		i=branch(0) 'počet bloků ve větvi
		while i=0 'prázdná větev takže (multi)skok na neprázdnou větev vlevo
			index=index+branch(1)
			branch=tree(index)
			i=branch(0) 'počet bloků ve větvi
		wend
		i=i-1 'poslední blok ve větvi
		extendArray(pCont, iCount)
		if bHalf then 'přidat poloviční a krátký blok do kontejneru
			pCont(iCount)=array(iHalf+1, index)
			bHalf=false 'žádný dlaší půlblok do tohoto kontejneru
		else 'přidat pouze krátký blok do kontejneru
			pCont(iCount)=array(-1, index) '-1 že tam není půlblok
		end if
		iCount=iCount+1
		iBlocks=iBlocks-1
		iSpace0=iSpace0 - index - iDASHED 'nové prázdné místo v kontejneru

		rem změnit "dotčené" větve
		branch(0)=i 'snížit počet bloků ve větvi
		if i=0 then 'to byl poslední blok z větve
			if index=max then 'jde o poslední větev
				p=findNearestBranch(tree, index, true) 'nejbližší neprázdná levá větev
				branch2=p(0) 'nová nejvyší větev
				index=p(1)
				max=index 'nové maximum
			elseif index=min then 'jde o první větev
				p=findNearestBranch(tree, index, false) 'nejbližší neprázdná pravá větev
				branch2=p(0) 'nová nejnižší větev
				index=p(1)
				min=index 'nové minimum
			else 'jde o prostřední větev
				rem nastavit ukazatel v pravé větvi
				iRight=branch(2) 'ukazatel na pravou větev
				branch2=tree(index+iRight) 'pravá větev
				iPointerR=branch2(1) + branch(1)
				branch2(1)=iPointerR 'změnit levý ukazatel v pravé větvi
				rem nastavit ukazatel v levé větvi
				iLeft=branch(1) 'ukazatel na levou větev
				branch2=tree(index+iLeft) 'levá větev
				iPointerL=branch2(2) + branch(2)
				branch2(2)=iPointerL 'změnit pravý ukazatel v levé větvi
			end if
		end if
	wend
	rem přidat blok do kontejneru
	if bHalf AND iCount=0 then 'pouze jeden půlblok do kontejneru
		pCont=array(array(iHalf+1, -1))
	else 'více bloků v kontejneru
		redim preserve pCont(iCount-1)
	end if
	extendArray(pContainers, iCONT)
	pContainers(iCONT)=pCont
	iCONT=iCONT+1
	exit function
bug:
	bug("fillContainer")
End Function

Function findNearestBranch(tree(), ByVal index&, bLeft as boolean) as array 'najít nejbližší větev; bLeft je pro levou jinak pravou
	on local error goto bug
	dim branch(), iPointer&, iLeft%, iLeft2%
	iLeft=iif(bLeft, 1, 2)
	branch=tree(index)
	do
		iPointer=branch(iLeft) 'ukazatel na další větev
		index=index+iPointer
		branch=tree(index) 'předpokládaná nová větev
	loop while branch(0)=-1 'prázdná větev tak testnout další
	iLeft2=iif(bLeft, 2, 1)
	branch(iLeft2)=0 'nová minimální či maximální větev
	findNearestBranch=array(branch, index)
	exit function
bug:
	bug("findNearestBranch")
End Function

Function getBlocks(oDoc as object, sBLOCKSTART$, sBLOCKEND$, oStatusbar as object, iCount&, iStep&) as array 'dostat velikosti a .getTransferable() blocků; zbytek glob.proměnných
	on local error goto bug
	dim oDesc as object, oFound as object, data as object, p(iCount), i&, oCur as object, oVCur as object, oEnum as object, ibound&
	oCur=oDoc.Text.createTextCursor
	oVCur=oDoc.CurrentController.ViewCursor

	rem možné přes .lockControllers()	
	rem odstranit možná Zalomení stránky z odstavců a tabulek
	oEnum=oDoc.Text.createEnumeration
	while oEnum.hasMoreElements
		oFound=oEnum.nextElement
		if oFound.supportsService("com.sun.star.text.Paragraph") then 'odstavec
			oFound.BreakType=0
		elseif oFound.supportsService("com.sun.star.text.TextTable") then 'tabulka
			oFound.BreakType=0
		end if
	wend

	rem najít první začátek bloku
	oDesc=oDoc.createSearchDescriptor
	with oDesc
		.SearchRegularExpression=true
		.SearchString=sBLOCKSTART
	end with
	oFound=oDoc.findFirst(oDesc) 'najít první začátek bloku
	if isNull(oFound) then problem(oDoc, "No Start of block!", 16)

	rem zkopírovat bloky do pole
	dim bEnd as boolean
	oFound=oFound.Start 'najít též 1. blok
	while NOT bEnd
		rem najít začátek bloku
		oDesc.SearchString=sBLOCKSTART
		oFound=oDoc.findNext(oFound.End, oDesc)
		if NOT isNull(oFound) then
			if NOT isEmpty(oFound.Cell) then 'začátek bloku je v tabulce
				oDoc.CurrentController.select(oCur)
				problem("Start of block is in Table!", 16)
			end if
			with oCur
				.gotoRange(oFound.Start, false) 'kurzor na začátek bloku (pro očekávanou kopii)
				.ParaTopMargin=0 'nulový horní okraj odstavce
			end with

			rem najít konec bloku
			oDesc.SearchString=sBLOCKEND
			do 'pro jistotu ignorovat konce bloků v tabulkách
				oFound=oDoc.findNext(oFound.End, oDesc)
				if isNull(oFound) then
					oCur.gotoEnd(true)
					oDoc.CurrentController.select(oCur)
					if oDoc.hasControllersLocked then oDoc.unlockControllers
					if NOT oDoc.CurrentController.Frame.ComponentWindow.isVisible then oDoc.CurrentController.Frame.ComponentWindow.Visible=true
					problem("No End of block!", 16)
				end if
			loop until isEmpty(oFound.Cell)

			rem zkopírovat blok
			oCur.gotoRange(oFound.Start, true)
			extendArray(p, i)
			p(i)=oDoc.CurrentController.getTransferableForTextRange(oCur) 'blok jako .getTransferable()
			with oCur 'dát Zalomení stránky po bloku
				.collapseToEnd
				.BreakType=com.sun.star.style.BreakType.PAGE_AFTER 'vložit Zalomení stránky
			end with
			i=i+1
			if i MOD iStep=0 then oStatusbar.setValue(i) 'aktualizovat ukazatel průběhu
		else 'nenalezen blok tak konec
			bEnd=true
		end if
	wend
	redim preserve p(i-1)

	rem zjistit velikosti bloků
	dim y&, iPage&, pBig(iREDIM), pHalf(iREDIM), pShort(iREDIM), iBig&, iHalf&, iShort&, iSize&, j&, oBlock as object
	iMIN=iHALFED : iMAX=0 : iMINHALF=iHALFED : iMAXHALF=0
	rem vlastnost Position viditelného kurzoru oVCur musí být přes .unlockControllers()	
	if oDoc.hasControllersLocked then oDoc.unlockControllers
	for i=lbound(p) to ubound(p)
		oBlock=p(i) 'jeden blok
		j=j+1
		with oVCur
			.jumpToPage(j)
			.jumpToStartOfPage
			y=.Position.Y 'počásteční pozice bloku
			iPage=.Page 'stránka na začátku bloku
			.jumpToEndOfPage
		end with
		while NOT isEmpty(oVCur.Cell) 'není-li viditelný kurzor v tabulce tak jde o velký blok
			with oVCur
				.jumpToNextPage
				.jumpToEndOfPage
				j=j+1
			end with
		wend
		iPage=oVCur.Page-iPage 'počet stránek pro blok
		iSize=oVCur.Position.Y - y
		if iPage=0 then 'krátký nebo půlblok
			if iSize>iHALFED then 'blok je delší jak půl stránky ale kratší než stránka
				insertItemToBranch(pHalf, iHalf, iSize, oBlock)
				if iSize<iMINHALF then iMINHALF=iSize
				if iSize>iMAXHALF then iMAXHALF=iSize
			else 'krátký blok
				insertItemToBranch(pShort, iShort, iSize, oBlock)
				if iSize<iMIN then iMIN=iSize 'nejmenší krátký blok
				if iSize>iMAX then iMAX=iSize 'největší krátký blok
			end if
		else 'půlblok (ale na celoiu stránku) nebo velký blok
			iSize=iSize - iPage*iGAP
			if iSize<=iHEIGHT then 'půlblok na celou stránku
				insertItemToBranch(pHalf, iHalf, iHEIGHTED, oBlock) '! možná iSize namísto iHEIGHTED !
				if iSize<iMINHALF then iMINHALF=iHEIGHTED
				if iSize>iMAXHALF then iMAXHALF=iHEIGHTED
			else 'velký blok (delší než stránka)
				insertItemToBranch(pBig, iBig, iSize, oBlock)
			end if
		end if
	next i

	rem nastavit skutečné velikosti polí
	if iBig=0 then
		pBig=array()
	else 'velké bloky jsou vzácné ale vždy přesahují velikost stránky takže pro ně není dělána žádná optimalizace
		redim preserve pBig(iBig-1) 'velké bloky
	end if
	if iHalf=0 then
		pHalf=array()
	else
		redim preserve pHalf(iHalf-1) 'půlbloky
	end if
	if iShort=0 then
		pShort=array()
	else
		redim preserve pShort(iShort-1) 'krátké bloky
	end if

	oDoc.lockControllers
	deleteDocument(oDoc)
	getBlocks=array(pBig, pHalf, pShort)
	exit function
bug:
	bug("getBlocks")
End Function

Sub getGlobals(oDoc as object, sBLOCKEND$) 'nastavit nějaké globální proměnné
	on local error goto bug
	dim oDesc as object, oFound as object, oCur as object, oVCur as object, oBorder as new com.sun.star.table.BorderLine2, y&, iPages&, oPage as object, s$
	oCur=oDoc.Text.createTextCursor
	oVCur=oDoc.CurrentController.ViewCursor
	oDesc=oDoc.createSearchDescriptor
	with oDesc
		.SearchString=sBLOCKEND
		.SearchRegularExpression=true
		.SearchBackwards=true
	end with
	rem přidat poslední stránku pouze s Čárkovanou čárou pro vytvoření jednotné Čárkované čáry
	oCur.gotoEnd(false)
	oFound=oDoc.findNext(oCur.Start, oDesc) 'Čárkovaná čára
	if isNull(oFound) then problem(oDoc, "No Dashed line in document") 'v dokumentu chybí Čárkovaná čára
	with oFound 'vlastnosti Čárkované čáry
		rem bez okrajů atd.
		.setAllPropertiesToDefault
		.TopBorderDistance=0
		.TopBorder=oBorder
		.ParaTopMargin=0
		.ParaBottomMargin=0
		.CharHeight=iDASHEDHEIGHT
		.CharHeightAsian=iDASHEDHEIGHT
		.CharHeightComplex=iDASHEDHEIGHT
		.CharColor=RGB(0, 0, 0) 'barva čáry
		.String=sMINUS 'dát první mínus pro Čárkovanou čáru
	end with
	rem vyplnit číáru mínusy 
	oVCur.gotoRange(oFound.End, false)
	y=oVCur.Position.Y
	while oVCur.Position.Y=y 'přidávat mínusy až se nevejdou na jednu řádku
		with oVCur
			.String=sMINUS
			.collapseToEnd
		end with
	wend
	with oVCur 'smazat pár mínusů aby byly jen na jedné řádce
		.goLeft(6, true)
		.String=sNULL
	end with
	rem zjistit výšku stránky a mezery mezi stránkami
	with oCur
		.gotoRange(oFound.Start, false)
		.BreakType=com.sun.star.style.BreakType.PAGE_BEFORE 'vložit Zalomení stránky
		.gotoEndOfParagraph(true)
	end with
	oVCur.gotoRange(oFound.Start, false)
	y=oVCur.Position.Y
	iPages=oDoc.CurrentController.PageCount-1 'původní počet stránek
	if iPages=0 then problem(oDoc, "Only one page")
	oPage=oDoc.StyleFamilies.getByName(sPAGESTYLES).getByName(oVCur.PageStyleName) 'poslední stránka
	iHEIGHT=oPage.Height 'velikot stránky 1/100mm
	iHEIGHTED=iHEIGHT - oPage.TopMargin - oPage.BottomMargin 'velikost stránky bez svislých okrajů
	iGAP=y / iPages - iHEIGHT 'y=(iHEIGHT+iGAP) * iPages; 1/100mm
	oCur.gotoEndOfParagraph(true)
	oDoc.Text.insertControlCharacter(oCur.End, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, true) 'vložit Enter a Čárkovanou čáru
	oVCur.gotoRange(oCur.End, false)
	iDASHED=oVCur.Position.Y - y 'velikost Čárkované čáry v 1/100mm
	iHALFED=(iHEIGHTED - iDASHED) / 2 'polovina stránky
	with oCur
		.BreakType=0 'odstranit Zalomení stránky
		.ParaAdjust=3 'zarovnání na střed
		.CharFontName=sDASHEDFONT 'výchozí font Čárkované čáry
	end with
	oDASHED=oDoc.CurrentController.getTransferableForTextRange(oCur) 'zkopírovat Čárkovanou čáru
	exit sub
bug:
	bug("getGlobals")
End Sub

Function getSpace(oDoc as object, oVCur as object) as long 'získat zbývající prázdné místo na stránce (!!! bacha na vertikální okraje stránky či odstavců !!!)
	on local error goto bug
	dim iPage&, y&, iTop&, iBottom&, oPageStyle as object, iSpace&
	iPage=oVCur.Page 'aktuální stránka
	oPageStyle=oDoc.StyleFamilies.getByName(sPAGESTYLES).getByName(oVCur.PageStyleName)
	y=oVCur.Position.Y
	iSpace=iPage*(iHEIGHT + iGAP) - iGAP - y 'iPage*iHEIGHT + (iPage-1)*iGAP - y
	getSpace=iSpace - oPageStyle.BottomMargin 'bez spodního okraje stránky
	exit function
bug:
	bug("getSpace")
End Function

Sub insertItemToBranch(p(), ByRef i&, iSize&, item()) 'přidat položku do větve; zvyšuje proměnnou i& (ByRef) !!!
	dim ibound&
	on local error goto bug
	extendArray(p, i)
	p(i)=array(iSize, item) 'vložit položku
	i=i+1
	exit sub
bug:
	bug("insertItemToBranch")
End Sub

Sub insertPageBreak(oCur as object) 'vložit Zalomení stránky před oCur
	on local error goto bug
	with oCur 'insert Page Break
		.gotoEnd(false)
		.String=chr(&h200B&) 'dát Nulovou mezeru na začátek prázdné stránky pro bezpečné Zalomení stránky
		.ParaTopMargin=0 'bez Horního okraje odstavce
		.ParaBottomMargin=0
		.BreakType=com.sun.star.style.BreakType.PAGE_BEFORE
		.CharHeight=2 'malá velikost nulové mezery
		.CharHeightAsian=2
		.CharHeightComplex=2
	end with
	exit sub
bug:
	bug("insertPageBreak")
End Sub

Function pasteBlock(oDoc as object, oCur as object, data as object) 'vložit blok na konec dokumentu
	on local error goto bug
	oCur.gotoEnd(false)
	with oDoc.CurrentController
		.select(oCur)
		.insertTransferable(data)
	end with
	with oCur
		.gotoEnd(false)
		.ParaKeepTogether=false
	end with
	exit function
bug:
	bug("pasteBlock")
End Function

Sub pasteBlockHalf(oDoc as object, pHalf(), ByRef iHalf&, oCur as object) 'vložit půlblok
	on local error goto bug
	if iHalf>-1 then 'jsou nějaké půlbloky
		dim data as object
		oCur.gotoEnd(false)
		data=pHalf(iHalf)(1)
		with oDoc.CurrentController
			.select(oCur)
			.insertTransferable(data)
		end with
		with oCur
			.gotoEnd(false)
			.ParaKeepTogether=false
		end with
		iHalf=iHalf-1
	end if
	exit sub
bug:
	bug("pasteBlockHalf")
End Sub

Function pasteDashedLine(oDoc as object, min&, oCur as object, oVCur as object, optional iHalf&) as boolean 'vložit buď Čárkovanou čáru nebo Zalomení stránky
	on local error goto bug

	iNO=iNO+1
	if DEBUG then 'DEBUGOVÁNÍ: přidat číslo před Čárkovanou čáru
		with oCur
			.gotoStartOfParagraph(false)
			.CharHeight=iDASHEDHEIGHT-1
			.String=iNO
			.gotoEndOfParagraph(false)
		end with
	end if

	dim iSpace&, bBreak as boolean, iPageHeight&, oPageStyle as object
	oCur.gotoEnd(false)
	oVCur.gotoRange(oCur.End, false)
	iSpace=getSpace(oDoc, oVCur) 'prázdné místo na stránce
	if iSpace<(iDASHED+min) then 'Zalomení stránky
		oDoc.Text.insertControlCharacter(oCur.End, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, true) 'vložit Enter
		with oCur
			.BreakType=com.sun.star.style.BreakType.PAGE_BEFORE
			.gotoEnd(false) 'kurzor na novou stránku
			.ParaTopMargin=0 'ne horní okraj
		end with
		bBreak=true
	else 'Čárkovaná čára
		oPageStyle=oDoc.StyleFamilies.getByName(sPAGESTYLES).getByName(oVCur.PageStyleName) 'aktuální Styl stránky
		' iPageHeight=iHEIGHT - oPageStyle.BottomMargin - oPageStyle.TopMargin 'page height without vertical margins
		iPageHeight=iHEIGHTED ' výška stránky bez svislých okrajů
		if iSpace>=iPageHeight then 'kurzor je na začátku nové stránky tudíž nevkládat Čárkovanou čáru
			with oCur 'vložit Zalomení stránky
				.gotoEnd(false)
				.BreakType=com.sun.star.style.BreakType.PAGE_BEFORE
			end with
			if NOT isMissing(iHalf) then 'test na půlblok
				if iHalf>-1 then bBreak=true 'je možné vložit nový půlblok
			end if
		else 'vložit Čárkovanou čáru
			with oDoc.CurrentController
				.select(oCur)
				.insertTransferable(oDASHED)
			end with
		end if
	end if
	pasteDashedLine=bBreak
	exit function
bug:
	bug("pasteDashedLine")
End Function

Sub pasteDashedLine2(oDoc as object, oCur as object) 'vložit Čárkovanou čáru na pozici oCur
	on local error goto bug

	iNO=iNO+1
	if DEBUG then 'DEBUGOVÁNÍ: přidat číslo k Čárkované čáře
		with oCur
			.gotoEnd(false)
			.CharHeight=iDASHEDHEIGHT-1
			.String=iNO
			.gotoEnd(false)
		end with
	end if

	oCur.gotoEnd(false)
	with oDoc.CurrentController
		.select(oCur)
		.insertTransferable(oDASHED)
	end with
	exit sub
bug:
	bug("pasteDashedLine2")
End Sub

Sub problem(oDoc as object, s$, optional i%, optional sTitle$) 'nějaký problém v dokumentu
	if isMissing(i) then i=0
	if isMissing(sTitle) then sTitle=sNULL
	removeLock(oDoc)
	msgbox(s, i, sTitle)
	stop
End Sub

Sub removeKeepTogether(oDoc as object) 'odstranit vlastnost "Spojit s následujícím odstavcem" a nulové Horní okraje
	on local error goto bug
	dim oEnum as object, o as object
	oEnum=oDoc.Text.createEnumeration
	do while oEnum.hasMoreElements
		o=oEnum.nextElement
		if o.supportsService("com.sun.star.text.Paragraph") then 'paragraph
			oDoc.CurrentController.select(o)
			with o
				.ParaKeepTogether=false 'žádné "Spojit s následujícím odstavcem"
				.ParaSplit=true 'povolit rozdělení odstavce přes stránky
				.ParaOrphans=0
				.ParaWidows=0
				.ParaTopMargin=0 'nenulový horní okraj může dělat problémy neboť vkládaný blok jej mít nemusí a jak se to zmixuje tak to nesedí
			end with
		elseif o.supportsService("com.sun.star.text.TextTable") then 'tabulka
			with o
				.KeepTogether=false 'žádné "Spojit s následujícím odstavcem"
				.Split=true 'povolit rozdělení přes stránky
			end with
		end if
	loop
	exit sub
bug:
	bug("removeKeepTogether")
End Sub

Sub removeLock(oDoc as object) 'odstraní zamčení a zneviditelnění okna dokumentu
	on local error goto bug
	dim undoMgr as object, oStatusbar as object
	undoMgr=oDoc.UndoManager
	oStatusbar=oDoc.CurrentController.StatusIndicator
	if oDoc.hasControllersLocked then oDoc.unlockControllers
	if NOT oDoc.CurrentController.Frame.ComponentWindow.isVisible then oDoc.CurrentController.Frame.ComponentWindow.Visible=true
	if undoMgr.isLocked then undoMgr.unlock
	with oStatusbar
		.end
		.reset
	end with
	exit sub
bug:
	bug("removeLock")
End Sub

Function sortHalfBlocks(pHalf()) as array 'seřadit půlbloky
	on local error goto bug
	dim min&, max&, i&, iSize&, p(iMINHALF to iMAXHALF), item as variant, arr(), iCount&, ibound&, j&, o as variant
	min=iHEIGHT
	j=ubound(pHalf)
	dim pHalf2(j)
	for i=lbound(pHalf) to j
		iSize=pHalf(i)(0) 'velikost bloku
		item=p(iSize)
		if TypeName(item)=sVARIANT then 'přidat .getTransferable() objektu do větve
			iCount=p(iSize)(0)
			arr=p(iSize)(1)
			extendArray(arr, iCount)
			o=pHalf(i)(1) 'objekt s .getTransferable()
			arr(iCount)=o
			p(iSize)(0)=iCount+1
			p(iSize)(1)=arr
		else 'nová větev ve stromu
			redim arr(iREDIM)
			o=pHalf(i)(1)
			arr(0)=o
			p(iSize)=array(1, arr)
		end if
	next
	rem projít pole a vybrat jen větve
	dim k&
	for i=lbound(p) to ubound(p)
		item=p(i)
		if TypeName(item)=sVARIANT then
			iCount=item(0)
			for j=0 to iCount-1
				pHalf2(k)=array(i, item(1)(j))
				k=k+1
			next j
		end if
	next i
	pHalf=pHalf2
	exit function
bug:
	bug("sortHalfBlocks")
End Function