Visio Guy

Visio Discussions => Programming & Code => Topic started by: Thomas Winkel on November 26, 2019, 04:20:16 PM

Title: Sketch Tool
Post by: Thomas Winkel on November 26, 2019, 04:20:16 PM
Hi,

the code below makes a sketch out of a selected diagram and vice versa, see attached screenshot.
Funny, isn't it?

BR,
Thomas


Public Sub sketch()
    Dim shp As Visio.Shape
   
    For Each shp In ActiveWindow.Selection
        sketchRecursive shp
    Next shp
End Sub

Public Sub unSketch()
    Dim shp As Visio.Shape
   
    For Each shp In ActiveWindow.Selection
        unSketchRecursive shp
    Next shp
End Sub

Private Sub sketchRecursive(shp As Visio.Shape)
    Dim subShp As Visio.Shape
   
    shp.Cells("SketchEnabled").Formula = True
    shp.Cells("SketchLineWeight").Formula = "0.2*LineWeight"
    shp.Cells("SketchAmount").Formula = 15
    shp.Cells("SketchSeed").Formula = 0
    shp.Cells("SketchLineChange").Formula = "20%"
    shp.Characters.CharProps(visCharacterFont) = ActiveDocument.Fonts.Item("Ink Free").ID
   
    For Each subShp In shp.Shapes
        sketchRecursive subShp
    Next subShp
End Sub

Private Sub unSketchRecursive(shp As Visio.Shape)
    Dim subShp As Visio.Shape
   
    shp.Cells("SketchEnabled").Formula = False
    shp.Characters.CharProps(visCharacterFont) = ActiveDocument.Fonts.Item("Calibri").ID
   
    For Each subShp In shp.Shapes
        unSketchRecursive subShp
    Next subShp
End Sub
Title: Re: Sketch Tool
Post by: Paul Herber on November 26, 2019, 08:32:50 PM
What fun!
Title: Re: Sketch Tool
Post by: wapperdude on November 27, 2019, 03:30:34 AM
Fun indeed!

I have a couple suggested changes.  The first is to add pct sign.  Otherwise there's error for that entry in shapesheet.

    shp.Cells("SketchLineChange").Formula = "20%"


The 2nd catches the possible situation where the 2D shape might have either a begin or end arrowhead that doesn't show because of the fill assignments.  But, once sketch is set true, the arrowheads show up.  So, following code corrects that situation.


    If Not (shp.OneD) Then
        shp.Cells("BeginArrow").Formula = 0
        shp.Cells("EndArrow").Formula = 0
    End If


Finally, a third suggestion is to add "On error resume next" at the beginning of the recursive routine.  I found that Visio's sidebrace shape has a guarded cell and caused the code to crash.   

To sum it all up, the revised code might look like this:

Private Sub sketchRecursive(shp As Visio.Shape)
    Dim subShp As Visio.Shape

    On Error Resume Next

    shp.Cells("SketchEnabled").Formula = True
    shp.Cells("SketchLineWeight").Formula = "0.2*LineWeight"
    shp.Cells("SketchAmount").Formula = 15
    shp.Cells("SketchSeed").Formula = 0
    shp.Cells("SketchLineChange").Formula = "20%"
    shp.Characters.CharProps(visCharacterFont) = ActiveDocument.Fonts.Item("Ink Free").ID

    If Not (shp.OneD) Then
        shp.Cells("BeginArrow").Formula = 0
        shp.Cells("EndArrow").Formula = 0
        shp.Cells("SketchLineChange").Formula = "20%"
    End If
   
    For Each subShp In shp.Shapes
        sketchRecursive subShp
    Next subShp
End Sub


Ooops, I did add a line to allow 2D shapes to have a different pct line change than 1D shapes.  But, I like the 20% for both quite well.

Really cool Thomas.
Title: Re: Sketch Tool
Post by: wapperdude on November 27, 2019, 03:54:25 PM
BTW, reminds me of the sketchy / wacky development that Visio Guy did, and then I added some supplemental stuff.  2010, that was.  Nice to see Visio finally up to speed.  Reference has link to VG's development.  http://visguy.com/vgforum/index.php?topic=7757.msg33035#msg33035
Title: Re: Sketch Tool
Post by: Thomas Winkel on November 28, 2019, 05:39:16 PM
Thanks for your Feedback, Wapperdude.

Quote"20%"
Thanks, fixed in my code above.

QuoteBegin/EndArrow
Never seen that in my diagrams, but I was able to reproduce.
I wonder if there could be any reason, where a value <>0 is desired for a 2D shape.

Quote"On error resume next"
I had the same problem with some diagrams, but I used .FormulaForce
Maybe "On error resume next" is better for most cases.

Good idea to distinguish between 1D and 2D shapes.
I think best results would give to adapt the parameters by line length. See attached example.
Title: Re: Sketch Tool
Post by: wapperdude on November 28, 2019, 07:24:25 PM
QuoteNever seen that in my diagrams, but I was able to reproduce.
I wonder if there could be any reason, where a value <>0 is desired for a 2D shape.

I have a custom callout shape that has multiple geometry sections.  One for the "msg body" and 3 optional lines.  Because of this construction style, all lines get arrowheads.  Thus, this issue becomes relevant.  No idea how common it might be.