Visio Guy

Quote from: Surrogate on April 27, 2024, 08:48:44 PMI didn't try it yet

For versions 0.1.0 and 0.1.3 I didnt have button 'Online Shapes' at ribbon

Quote from: Thomas Winkel on April 29, 2024, 05:29:44 PMFinally working
https://github.com/Visio-Resources/VisioOnlineShapesLibrary/releases/tag/v0.1.4

Thank you, Thomas!
I try tested latest VisioOnlineShapesLibrary_0.1.6.msi version. I can see  button 'Online Shapes' at ribbon.

I upload two shapes. But cant upload whole stencil 

In pane I cant see online shapes from your site (www.visio-shapes.com)
 

😂😂😂

Be careful of handling Wapperdude_FormidableJob_Finished() event.
Errors could lead to unpredictable behavior.

Today I tried again some approaches and always got inconsistent results...
Time to put Visio aside for a few days and then start again with a blank drawing

Finally working
https://github.com/Visio-Resources/VisioOnlineShapesLibrary/releases/tag/v0.1.4

No new Features, but a confirmation that the installer works.
And the first beautiful shape from the community has been committed... ( thanks, Rolf!    )

From now on I will always link the current version in the opening post.
As well as some News, TODOs, Comments.

😂😂😂. My side's hurt.   Off to do other things....

OK. Ok. Ok.

This would be a complete solution as I recommend.  It solves the initial problem.  It improves shapesheet syntax issues.  See the attached file...it contains everything.  Also, the code is listed below for quick reference.   It is Yacine's code, with option to bypass the delay if the LiveDynamics is disabled.  This results in faster execution time and doesn't require code editing if LiveDynamics are enabled or disabled.  The actualRoutine omits the Undo stuff, but otherwise does the add / remove connect point rows.

I placed the LiveDynamic code in the ThisDocument code section...because I could...and to easily distinguish it from working code.

The attached file has the both the original shape and edited shape (shapesheet).
  > Page-2 has the updated shape.  Page-1 has original shape.
  > The height and width resizing formulae have been moved from User section, to their respective cells.
  > The formulae use the full, SETATREF functions.
  > The width has added condition to set width to size of text entered.  Thus, long text will fit without wrapping.
  > Added Action entries to allow enable/disable of live dynamics.
 
Note:  if this approach is put to use, I would comment out the debug.print statements in the code.

Module1 code:
Dim bBusy As Boolean
Dim counter As Long
Dim rejected As Long
'
Sub ConnPtAdjust(shp As Visio.Shape)
  Dim start As Double
 

  If bBusy Then
    Debug.Print "Reject event"
    rejected = rejected + 1
    counter = counter + 1

    Exit Sub
  Else
    rejected = 0
    counter = 0
    bBusy = True
    start = Timer
'    counter = counter + 1
    Debug.Print "Start time: ", start
    If Application.LiveDynamics Then
        While Timer - start < 1
          DoEvents
        Wend
    End If
    Debug.Print "Executing now @" & Timer, "repetition", counter, "Rejected events", rejected
    actualRoutine shp
    bBusy = False
  End If
End Sub

Sub actualRoutine(shp As Visio.Shape)
    connPtRow = shp.RowCount(visSectionConnectionPts) - 1   ' rownum used in vba formula generation is 0 based
    lastCPYVal = shp.CellsSRC(visSectionConnectionPts, connPtRow, visCnnctY).Result(visInches)

    If lastCPYVal >= 0.875 Then
'        Debug.Print "Add rows"
        rowsToAdd = 1 + Int((lastCPYVal - 0.875) / 0.625)
        rowNew = connPtRow
        rowsToAdd = 1 + Int((lastCPYVal - 0.875) / 0.625)
        ' we add rowsToAdd*2 cuz we add two conn points (left/right side of shape) per elevation

        For i = 1 To rowsToAdd
'            Debug.Print "Adding " & shp.Name & " Point " & rowNew

            ' left side conn point
            rowNew = rowNew + 1
'            Debug.Print "setting data"
            shp.AddRow visSectionConnectionPts, rowNew, visCnnctX
            shp.CellsSRC(visSectionConnectionPts, rowNew, visCnnctX).FormulaForceU = "Connections.X3"
            shp.CellsSRC(visSectionConnectionPts, rowNew, visCnnctY).FormulaForceU = "Connections.Y" & rowNew & "-0.625"
            shp.CellsSRC(visSectionConnectionPts, rowNew, visCnnctDirX).FormulaU = "Connections.DirX[3]"
            ' right side conn point
            rowNew = rowNew + 1
            shp.AddRow visSectionConnectionPts, rowNew, visCnnctX
            shp.CellsSRC(visSectionConnectionPts, rowNew, visCnnctX).FormulaForceU = "Connections.X4"
            shp.CellsSRC(visSectionConnectionPts, rowNew, visCnnctY).FormulaForceU = "Connections.Y" & rowNew
            shp.CellsSRC(visSectionConnectionPts, rowNew, visCnnctDirX).FormulaU = "Connections.DirX[4]"
        Next

    ' need to remove connection points
    ElseIf lastCPYVal < 0.375 Then
        For i = connPtRow To 1 Step -1 ' start removing conn points from last row, decreasing by two (left/right side of shape)
            If shp.CellsSRC(visSectionConnectionPts, i, visCnnctY).Result(visInches) < 0.375 Then
'                Debug.Print "Removing"; shp.Name & " Point " & i & ", " & shp.CellsSRC(visSectionConnectionPts, i, visCnnctY).Result(visInches)
                shp.DeleteRow visSectionConnectionPts, i
            Else
                Exit For
            End If
        Next

    End If
End Sub

ThisDocument code:
Sub DisAbleDyn()
    Application.LiveDynamics = False
    Debug.Print "FALSE"
End Sub
Sub EnAbleDyn()
    Application.LiveDynamics = True
    Debug.Print "TRUE"
End Sub


Interesting.  I went all the way back TO OP's original file and made the above changes.  Yes.  There does seem to be an issue with the code. 

@Thomas W:  My apologies.

@Thomas W:  I've tried repeatedly, and not had failure.

@Yacine:  Yes, default is on, so would require User intervention.  It can be in a macro, entry would be, Application.LiveDynamics = False.  Obviously, need 2nd macro to set back to True.  I did this and created to Action rows with RunMacro.  Works fine.  As for User...well, I think the OP may be the only one doing this, so, minor inconvenience.

Note:  The dynamics must be disabled before the macro is called.  Doing so in the macro is after the fact and too late to do any good.  To facilitate, I call macros from the Actions section in shapesheet.  Thus, just a right click away.

Can you confirm that this solves problem?

The Action rows:
Action.Row_3.Menu -> "_SetLiveDynamics"
Action.Row_4.Action -> RUNMACRO("ThisDocument.DisAbleDyn")+SETF(GetRef(Actions.Row_4.Checked),1)+SETF(GetRef(Actions.Row_5.Checked),0)
Action.Row_4.Menu -> "Disable"

Action.Row_5.Action -> RUNMACRO("ThisDocument.EnAbleDyn")+SETF(GetRef(Actions.Row_4.Checked),0)+SETF(GetRef(Actions.Row_5.Checked),1)
Action.Row_5.Menu -> "Enable" 

Quote from: wapperdude on April 28, 2024, 06:29:35 AMFound the issue.  It is linked to re-drawing...

Go to File>Options>Advanced.  Deselect Enable live dynamics.  That halts shape re-drawing, which halts events associated with dragging. 

Well, yes but no. I mean almost.
live dynamics is on by standard. For a standard solution it would be rather difficult to ask users to disable it.
Maybe the macro could / should disable the function by itself?

Quote from: wapperdude on April 28, 2024, 06:29:35 AMDeselect Enable live dynamics

Makes perfect sense because I had live dynamics disabled already.
So unexpected events only occurred sometimes (probably triggered by User.HeightCalc).