SETATREF(Height) / EventXFMod Behavior

[Yacine]

Found 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?

[wapperdude]

@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" 

[wapperdude]

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.

[wapperdude]

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:

Code Select Expand

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:

Code Select Expand

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


[Yacine]

Code Select Expand

if not bWapperdudeBusy then
  exploreVisioEvents
elif not bChildrenBusy
  BBQ
elif bWheatherFine
  go_hiking
else
  for i = 1 to todo_list.count
    if todo_list(i).bInTheMoodForTheTask then
      todo_list(i).finishTheFormidableJob
    endif
  next i
endif
 

[wapperdude]

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

[Thomas Winkel]

😂😂😂

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