Author Topic: Sketch Tool  (Read 349 times)

0 Members and 1 Guest are viewing this topic.

Thomas Winkel

  • Full Member
  • ***
  • Posts: 194
Sketch Tool
« on: November 26, 2019, 11:20:16 AM »
Hi,

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

BR,
Thomas

Code: [Select]
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
« Last Edit: November 28, 2019, 06:05:09 AM by Thomas Winkel »

Paul Herber

  • Global Moderator
  • Hero Member
  • *****
  • Posts: 2809
    • Paul Herber's website
Re: Sketch Tool
« Reply #1 on: November 26, 2019, 03:32:50 PM »
What fun!
Electronic and Electrical engineering, business and software stencils and applications for Visio -

https://www.paulherber.co.uk/

wapperdude

  • Global Moderator
  • Hero Member
  • *****
  • Posts: 3645
  • Ideas Visio-lized into solutions
Re: Sketch Tool
« Reply #2 on: November 26, 2019, 10:30:34 PM »
Fun indeed!

I have a couple suggested changes.  The first is to add pct sign.  Otherwise there's error for that entry in shapesheet.
Code: [Select]
    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.

Code: [Select]
    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:
Code: [Select]
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.
« Last Edit: November 26, 2019, 10:32:54 PM by wapperdude »
Visio 2019 Pro

wapperdude

  • Global Moderator
  • Hero Member
  • *****
  • Posts: 3645
  • Ideas Visio-lized into solutions
Re: Sketch Tool
« Reply #3 on: November 27, 2019, 10:54:25 AM »
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
« Last Edit: November 27, 2019, 11:05:53 AM by wapperdude »
Visio 2019 Pro

Thomas Winkel

  • Full Member
  • ***
  • Posts: 194
Re: Sketch Tool
« Reply #4 on: November 28, 2019, 12:39:16 PM »
Thanks for your Feedback, Wapperdude.

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

Quote
Begin/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.
« Last Edit: November 28, 2019, 12:41:14 PM by Thomas Winkel »

wapperdude

  • Global Moderator
  • Hero Member
  • *****
  • Posts: 3645
  • Ideas Visio-lized into solutions
Re: Sketch Tool
« Reply #5 on: November 28, 2019, 02:24:25 PM »
Quote
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.

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.
Visio 2019 Pro