[Solved] Draw from cells

[rad]

Hi,

Is it possible to make drawings sized as values in cells?


For example A1 is 10, A2 is 100

and AOO draws me a rectangle 10 / 100?

Thanks.

[acknak]

Is it possible to make drawings sized as values in cells? ...

Yes, it's called a graph Sorry. Weak humor.

Possible, I guess, but you'd have to use a macro program to do it. OOo (directly) supports only graphics made by hand.

[rad]

That is what I thought, but it dose not work on "Size and positon" dialog window.

Any sugestioms?

Thanks.

[keme]

You can make a graph that adjusts to those input values, but I can't see that it is very useful. See the attached file.

What I did:

• made a table with points in sequence to draw the rectangle
• made an x/y-graph based on that table and using lines only (no point marker symbols)
• removed the grid and the automatic scaling (so the specified dimensions would make a visible difference)
• adjusted size and scales so it's approximately 1:1 aspect ratio

[rad]

Thank You for Your help I like it! I'll test if it works good for me.

BR
R

[Charlie Young]

A cell function can't modify cell contents except through its return value, but apparently there is no rule against it adding a shape to the DrawPage.

I keep thinking this whole concept is shaky somehow, but it is amusing to play with. Here is a function to draw a RectangleShape based on position, size, and color specified in cells. The position and sizes are in centimeters, but that's not terribly important. I'm just having the function return the name, but that's not important either. Note that the shapes can be moved around just by changing the cells. Formulas are entered in F1:F3 in the attached spreadsheet.

Code: Select all

Function DrawRectangle(x As Long, y As Long, w As Long, h As Long, Sheet As Integer, RectName As String, RectColor As Long) As String
	Dim oDoc As Object
	Dim oSheet As Object
	Dim dPage As Object
	Dim oRect As Object
	Dim p As new com.sun.star.awt.Point
	Dim s As new com.sun.star.awt.Size
	Dim FoundIt As Boolean
	Dim c As Long, i As Long
	Dim v As Object
	
	oDoc = ThisComponent
	oSheet = oDoc.Sheets(Sheet)
	dPage = oSheet.DrawPage
	
	FoundIt = False
	c = dPage.getCount()
	i = c
	Do While i > 0 and not FoundIt
		v = dPage(i - 1)
		if InStr(v.ShapeType, "RectangleShape") > 0 and v.Name = RectName then
			dPage.remove(v)
			FoundIt = True
		else
			i = i - 1
		endif
	Loop
	oRect = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
	oRect.FillStyle = com.sun.star.drawing.FillStyle.SOLID
	oRect.Name = RectName
	dPage.add(oRect)
	p.X = 1000 * X
	p.Y = 1000 * Y
	s.Width = 1000 * w
	s.Height = 1000 * h
	
	oRect.setSize(s)
	oRect.setPosition(p)
	oRect.FillColor = RectColor
	DrawRectangle = RectName
End Function

I think I'm going to play with some more options. One can imagine adding a rotation parameter, and there's nothing sacred about rectangles. I also think, if this is at all worthwhile, it should be done in Python or even c++, which I'm also going to try.

[rad]

It is very nice!


It would be great if size resolution could be 0,00cm now when You make 1,6cm You have 2cm and when You make 1,4 You have 1 etc.

Thank You!

[Charlie Young]

It would be great if size resolution could be 0,00cm now when You make 1,6cm You have 2cm and when You make 1,4 You have 1 etc.

Thank You!

That is a consequence of my making the parameters Long instead of Double, and it's an easy change. The actual resolution is 1/100 mm, but that should be good enough. Here is the altered macro:

Code: Select all

Function DrawRectangle(x As Double,y As Double,w As Double, h As Double, Sheet As Integer, RectName As String, RectColor As Long) As String
	Dim oDoc As Object
	Dim oSheet As Object
	Dim dPage As Object
	Dim oRect As Object
	Dim p As new com.sun.star.awt.Point
	Dim s As new com.sun.star.awt.Size
	Dim FoundIt As Boolean
	Dim c As Long, i As Long
	Dim v As Object
	
	oDoc = ThisComponent
	oSheet = oDoc.Sheets(Sheet)
	dPage = oSheet.DrawPage
	
	FoundIt = False
	c = dPage.getCount()
	i = c
	Do While i > 0 and not FoundIt
		v = dPage(i - 1)
		if InStr(v.ShapeType, "RectangleShape") > 0 and v.Name = RectName then
			dPage.remove(v)
			FoundIt = True
		else
			i = i - 1
		endif
	Loop
	oRect = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
	oRect.FillStyle = com.sun.star.drawing.FillStyle.SOLID
	oRect.Name = RectName
	dPage.add(oRect)
	p.X = CLng(1000 * X)
	p.Y = CLng(1000 * Y)
	s.Width = CLng(1000 * w)
	s.Height = CLng(1000 * h)
	
	oRect.setSize(s)
	oRect.setPosition(p)
	oRect.FillColor = RectColor
	DrawRectangle = RectName
End Function

I have taken to making a Python add-in function out of this. It's mostly working, but I'm trying to extend it some, and I'm running into a few bugs -- small I hope. I want to post it in code snippets when I have it up to snuff. Might be a day or two to get everything working though.

[rad]

Great!

Adding names would be useful.

You have beer!

[Charlie Young]

Great!

Adding names would be useful.

I don't quite know what you have in mind here, could you explain further?

You have beer!

I've been known to go way overboard, but then again...

[rad]

Normally You can give rectangle a name when You double click on it.

and also,

It would be nice if rectangles is not drawed when X or Y cell value is 0.


Some times it is necessary to go way overboard.


Thank You again for Your help.

[Charlie Young]

Normally You can give rectangle a name when You double click on it.

and also,

It would be nice if rectangles is not drawed when X or Y cell value is 0.


Some times it is necessary to go way overboard.


Thank You again for Your help.

Relatively simple to do in a rudimentary form. With the text added though, one starts to think about all the formatting options.

But for starters, just add a sixth parameter for the "name," and assign it to the shape's string property in the macro:

Code: Select all

Function DrawRectangle(x As Double,y As Double,w As Double, h As Double, Sheet As Integer, RectName As String, RectColor As Long, RectText As String) As String
	Dim oDoc As Object
	Dim oSheet As Object
	Dim dPage As Object
	Dim oRect As Object
	Dim p As new com.sun.star.awt.Point
	Dim s As new com.sun.star.awt.Size
	Dim FoundIt As Boolean
	Dim c As Long, i As Long
	Dim v As Object
	
	oDoc = ThisComponent
	oSheet = oDoc.Sheets(Sheet)
	dPage = oSheet.DrawPage
	
	FoundIt = False
	c = dPage.getCount()
	i = c
	Do While i > 0 and not FoundIt
		v = dPage(i - 1)
		if InStr(v.ShapeType, "RectangleShape") > 0 and v.Name = RectName then
			dPage.remove(v)
			FoundIt = True
		else
			i = i - 1
		endif
	Loop
	If X > 0 And Y > 0 Then
		oRect = oDoc.createInstance("com.sun.star.drawing.RectangleShape")
		oRect.FillStyle = com.sun.star.drawing.FillStyle.SOLID
		oRect.Name = RectName
		dPage.add(oRect)
		p.X = CLng(1000 * X)
		p.Y = CLng(1000 * Y)
		s.Width = CLng(1000 * w)
		s.Height = CLng(1000 * h)
		
		oRect.setSize(s)
		oRect.setPosition(p)
		oRect.FillColor = RectColor
		oRect.String = RectText
	EndIf
	DrawRectangle = RectName
End Function

[rad]

Yeah, Thanks again...

[Charlie Young]

Now presenting...