OpenOffice.info

Code: Alles auswählen

Sub Test()
	Gitternetz(5, 50, 100) 'angaben in mm
End sub

Sub Gitternetz(abstand as integer, laenge as integer, hoehe as integer)

	Dim oDoc as object, oFrame as Object
	Dim oTxtCur as object, oFrameCur as Object
		
	Dim oText as object
	Dim oLinie as object
	Dim oCur as object
        Dim size as new com.sun.star.awt.Size    
 	Dim bLine as new com.sun.star.table.BorderLine
 	
 	oShapes = createUnoService("com.sun.star.drawing.ShapeCollection")
    
	oDoc = ThisComponent
	oTxtCur = oDoc.text.createTextCursor()
	
	' Längenangaben von mm in 1/1000cm umrechnen
    abstand = abstand*100
    laenge = laenge*100
    hoehe = hoehe*100
    
    anzahl_hLinien = hoehe / abstand
    anzahl_vLinien = laenge / abstand
    
    ' Horizontale Linien zeichnen und Rasterhinzufügen	
	for horizontal = 0 to anzahl_hLinien
		
		oLinie = oDoc.createInstance("com.sun.star.drawing.LineShape")
		
		size.Width  = laenge
    	        size.Height = 0
    
		With oLinie
    		.LineColor    = rgb(0, 0, 0)
			.AnchorType   = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
			.Size         = size
			.TextWrap     = com.sun.star.text.WrapTextMode.THROUGHT
			.VertOrientPosition = abstand * horizontal + abstand
			.HoriOrientPosition = abstand
			.lineWidth = 0
			.sizeProtect = true
			.MoveProtect = true
		End With
	
    	        oDoc.text.insertTextContent(oTxtCur, oLinie, false)
		oShapes.add(oLinie)
		
	next
	
	
    ' Horizontale Linien zeichnen und Rasterhinzufügen	
	for vertikal = 0 to anzahl_vLinien
		
		oLinie = oDoc.createInstance("com.sun.star.drawing.LineShape")
		
		size.Width  = 0
    	        size.Height = hoehe
    
		With oLinie
    		.LineColor    = rgb(0, 0, 0)
			.AnchorType   = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
			.Size         = size
			.TextWrap     = com.sun.star.text.WrapTextMode.THROUGHT
			.HoriOrientPosition = abstand * vertikal + abstand
			.VertOrientPosition = abstand
			.lineWidth = 0
			.sizeProtect = true
			.MoveProtect = true
		End With	
		
    	        oDoc.text.insertTextContent(oTxtCur, oLinie, false)
		oShapes.add(oLinie)
		
	next
	
	Group = oDoc.text.group(Shapes)

Code: Alles auswählen

Sub GroupShapeObj()
	Dim oDoc as Object
	Dim oDrawPage as Object
	Dim oShapeGroup as Object
	
	oDoc = ThisComponent
	oDrawPage = oDoc.DrawPage
	
	oShapeGroup = CreateUnoService("com.sun.star.drawing.ShapeCollection")
 	for i = 0 to oDrawPage.getCount()-1 
 		oShapeGroup.add(oDrawPage.getByIndex(i)) 
 	next i
 	oDrawPage.group(oShapeGroup)

End Sub

Code: Alles auswählen

Public oDoc as object
Public oLinie as object
Public oTxtCur as Object

Sub Test()
	Gitternetz(5, 50, 100,2) 'angaben in mm
End sub

Sub Gitternetz(abstand as integer, breite as integer, hoehe as integer, aussenabstand as integer)

 	'Gruppierungs-Objekt für das Gitternetz erstellen
 	oShapeGroup = createUnoService("com.sun.star.drawing.ShapeCollection")
 	
	' Längenangaben von mm in 1/1000cm umrechnen
    abstand = abstand*100
    breite = breite*100
    hoehe = hoehe*100
    aussenabstand = aussenabstand*100
	
    'Anzahl Linien Berechnen
    anzahl_hLinien = hoehe / abstand
    anzahl_vLinien = breite / abstand
    
    ' Horizontale Linien
	for horizontal = 0 to anzahl_hLinien
	
		'Position der Linien bestimmen
		HoriOrientPosition = 0 
		VertOrientPosition = abstand * horizontal
		
		' Horizontale Linien zeichnen
		LinienZeichnen(HoriOrientPosition, VertOrientPosition, 0, breite)
		
		' Linie dem Gitternetz hinzufügen, welches später gruppiert wird
		oShapeGroup.add(oLinie)		
	next
	
	
    ' Vertikale Linien
	for vertikal = 0 to anzahl_vLinien
	
		'Position der Linien bestimmen
		HoriOrientPosition = abstand * vertikal
		VertOrientPosition = 0
		
		' Vertikale Linien zeichnen
		LinienZeichnen(HoriOrientPosition, VertOrientPosition, hoehe, 0)
		
		' Linie dem Gitternetz hinzufügen, welches später gruppiert wird
		oShapeGroup.add(oLinie)
		
	next
	
	'Gitternetz gruppieren
	oGruppe = ThisComponent.DrawPage.group(oShapeGroup)
	With oGruppe
		.TopMargin = aussenabstand
		.BottomMargin = aussenabstand
		.LeftMargin = aussenabstand
		.RightMargin = aussenabstand
	end With
	
End Sub

Function LinienZeichnen(x as integer, y as integer, hoehe as integer, breite as integer)
 	
 	'Neue Linie vorbereiten
	oLinie = ThisComponent.createInstance("com.sun.star.drawing.LineShape")
	
	'Grösse der Linien bestimmen
	Dim size as new com.sun.star.awt.Size     
    size.Height = hoehe	
	size.Width  = breite 
	
	With oLinie
   		.LineColor    = rgb(0, 0, 0)
		.AnchorType   = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
		.TextWrap     = com.sun.star.text.WrapTextMode.THROUGHT
		.lineWidth    = 0
		.sizeProtect  = true
		.MoveProtect  = true
		.HoriOrientPosition = x
		.VertOrientPosition = y	
		.Size 		  = size	
	End With
   	
	'Einfügeort bestimmen
	oViewC = ThisComponent.getCurrentController().getViewCursor()
	
	If isEmpty(oViewC.textTable) then
		'Linien im Text einfügen
    	oTextC = ThisComponent.text.createTextCursorByRange(oViewC)
    	ThisComponent.text.insertTextContent(oViewC, oLinie, false)
	Else
		'Linien in Tabelle einfügen
		oZelle = oViewC.Cell
    	oTextC = oZelle.createTextCursorByRange(oViewC) 
    	oTextC.getText().insertTextContent(oViewC, oLinie, false)
	Endif

End Function