Changing size of shapes inside a group/ Filling pattern blurs

[Pauket]

Hello fellow Visio experts,
i had to work with visio for the first time and faced two problems i found no solution for.

First problem:
i want to change the height of 2 shapes inside a group of shapes by rightclicking and selecting the size.
So i added an action section into the shapesheet of the group and used SETF referring to the two shapes i want to change with shapexxx!height.
It works all fine but now the problem occurs when i want to save this shape by dragging it into the left toolbar. When i pull it out of the bar, the shapes inside the group get new names(numbers).
But the code still says "shapexxx" and not "shapexxx+1", so when i rightclick and select the height it won't work.
Is there any way to refer to the shape inside a group other than by the name, so that i can save the shape with a working code?
Or do you have a different solution for this problem?
Answers are welcome.

Second problem:
i need to fill a squared shape with lines that have a specific distance between them (and a specific width and color) and when i drag the width of the shape the lines have to reach the whole shape.
I also need to be able to change the height of the shape and the lines still have to go the the top.
I tried using a filling pattern, but the lines tend to blur when being saved as a PDF and when i change the height the pattern stops, so i would like to avoid that.
I also tried a little do-while loop in vba but since i'm new to visio i dont know where to fit in the code.


Sorry for spelling mistakes, english is not my first language.
Thanks
Pauket

[Yacine]

Problem 1:
sheet.1 being the group shape, sheet.2 and sheet.3 its sub-shapes.
Do whatever needs to be done to get the desired height value and store the result in a field like user.height.
Two possibilites:
1) in sheet.1 add a cell in the user section: user.action = setf(getref(sheet.2), user.height
When sheet.2 gets renamed the formula is adjusted automatically. Just make sure you don't write references as string.
2) Better solution: in sheet.2 - height = guard(sheet.1!user.height)
This will also handle the renaming and is probably faster.

Problem 2:
can you better describe the shape or upload it?

[Pauket]

Thanks for the solution for Problem 1, works all fine.

Problem 2:
Ok, i have to fill a number of various sized square-objects with vertical lines. The lines have to be in a set size and Color.
In addition there have to be a set gap between each line. The lines have to go from the bottom to the top of the square.
When i Change the size of the shape, the lines have to keep the same distance and should not spread but get more in number.

A custom filling pattern solves this problem quite well but when the visio map is saved as a pdf the lines blur and get ugly.

So i'm looking for a code that tells visio to draw lines every x meters for the whole range of the shape.

I tried it with do "draw lines" every 1.6m for x <= "width" but i dont know how to tell visio to draw the lines.

I hope this explains the problem better.

[Yacine]

I tried to replicate the described problem.

When EXPORTing to PDF the fill patterns get indeed blurry.
PRINTing them as PDF gives crisp result. Requires Adobe Acrobat.

Tried to replace lines by rectangles - no improvement.
Export still blurry, printing as PDF even skipped some instances.

Came up with the most inellegant solution. A group containing a big (100) amount of "smart" vertical lines. The gap is adjustable by shape data. The lines themselves get arranged by a number which is increased at each drop. So if the 100 lines are not enough, open the group and duplicate the last line as much as need.

Check the attachment.

HTH,
Y.

[Pauket]

Your solution is working fine for almost 2 years now, but there is something that i would like to improve here and can't solve myself.

Due to the fact, that every time the shape is dropped 100+ lines are calculated the documents gets really slow which causes problems when multiple of these "Line-Shapes" are used in the same document. (Don't know if this effect occurs in your "naked" suggestion, i changed color, thickness and number of the lines which may cause longer calculations)

I tried using the "Geometry1.noline" instead of "noshow" but nothing changed. I also tried limiting the amount of lines by limiting the Prop.Nr. to "width/gap" but the lines just stack up at the end then.

Long story short: is there a way to limit the amount of drawn lines (like in Yacines attached solution) to fit right into the shapes size instead of by a fixed number?

Any ideas appreciated.

[vojo]

for #2, should look at the resolution in the pdf domain (pts per inch).
at least pdf995 (freeware - ads - I have used this well for 20 years) allows to set that value

Of course, could play games about pdf sheet size to "stretch image  for same x/y ratio"
pdf995 will allow that as well.

Just a thought.

[Yacine]

Hello Pauket,

The old smart shape is a group. One could all the same, draw the lines directly in the geometry section.
Here's a routing that builds up such a shape. (You won't need it after having set up the shape).

Code Select Expand

Sub raster()
   
    Dim shp As Shape
   
    Set shp = ActivePage.Shapes.ItemFromID(54673)
    With shp
       
        .AddSection visSectionFirstComponent + .GeometryCount
        sec = visSectionFirstComponent + .GeometryCount - 1
        .AddRow sec, visRowComponent, visTagComponent
        For i = 0 To 100
            Row = .AddRow(sec, visRowLast, visTagMoveTo)
            .CellsU("Geometry" & .GeometryCount & ".X" & Row).FormulaU = "min(width, prop.gap*" & i & ")"
            '.CellsU("Geometry" & .GeometryCount & ".Y" & Row).FormulaU = "Height * 0"
            Row = .AddRow(sec, visRowLast, visTagLineTo)
            .CellsU("Geometry" & .GeometryCount & ".X" & Row).FormulaU = "min(width, prop.gap*" & i & ")"
            .CellsU("Geometry" & .GeometryCount & ".Y" & Row).FormulaU = "Height * 1"
        Next i
    End With

End Sub

Rgds,
Y.

[Pauket]

Your Code works completely fine. But there is one little misbehavior:

due to your solution using the min-function the last drawn line is always right at the end of the shape (width*1) which leads to a smaller gap that is less than the prop.Gap.
I tried fixing this issue by removing the min and adding a termination: prop.gap * i  >= width - prop.gap so that the last line shall be the last drawn line < width.

But due to my lack of knowlege in VBA, the termination doesnt work

Code Select Expand

Sub rater()
   
    Dim shp As Shape
   
    Set shp = ActivePage.Shapes.ItemFromID(2017)
    With shp
       
        .AddSection visSectionFirstComponent + .GeometryCount
        sec = visSectionFirstComponent + .GeometryCount - 1
        .AddRow sec, visRowComponent, visTagComponent
        For i = 0 To 400
            Row = .AddRow(sec, visRowLast, visTagMoveTo)
            .CellsU("Geometry" & .GeometryCount & ".X" & Row).FormulaU = "prop.Gap * " & i & ""
            .CellsU("Geometry" & .GeometryCount & ".Y" & Row).FormulaU = "Height * 0 + 10 mm"
            Row = .AddRow(sec, visRowLast, visTagLineTo)
            .CellsU("Geometry" & .GeometryCount & ".X" & Row).FormulaU = "prop.Gap * " & i & ""
            .CellsU("Geometry" & .GeometryCount & ".Y" & Row).FormulaU = "Height * 1 - 10 mm"
            If "prop.Gap *i" >= "width - prop.Gap" Then GoTo VarLines
        Next i
VarLines:
        .CellsU("LineWeight").FormulaU = "0.25 pt"
        .CellsU("LineColor").FormulaU = "RGB(84, 139, 212)"
        .CellsU("LineCap").FormulaU = "1"
       
    End With

End Sub


I also tried end instead of goto, but doesnt work either.
Is there an error in my code or is this approach not doable?

Thx for the help so far

Pauket

[Yacine]

I think you can replace my formula "min(width, prop.gap*" & i & ")"
by "if(prop.gap*" & i & ">width,0,prop.gap*" & i & ")"

So far for the quick answer.

A more extensive answer would need to explain, that my routine doesn't rely on the code for drawing the lines. The behaviour is all stored in the shapesheet.
Any if statement in the VBA would set up the shape for this very specific width. ... not what you want.
The modification would now be to place the lines you don't want to see at the beginning of the shape instead of its end.
The "min" formula sets the remaining (unwanted) lines at the end. With an if statement in a shapesheet formula you can set them at the beginning.
I think that this if formula is slower than the min calculation. I leave it up to you the compare both shapes.

Cheers,
Y.