Unexpected behaviour while trying to reduce nodes via a loop

Hi folks,

I have a workflow where I'm exporting parts from CAD and converting them. 

The parts do not need to be perfect, duplicates given the tolerances in what I'm doing, but I definitely want to reduce the number of nodes.  Some items can have 2000 nodes on what appears to be a straight line.

Looking through the forum I found a previous post about using "InvokeItem" to use the "Auto Reduce" feature and stuck that into a script.

If I have one shape selected the nodes get reduced as I'd expect, but if I try to look through a selection of shapes, the script runs but doesn't reduce the nodes at all.

I feel like I'm missing some very basic behaviour here, but if anybody has any hints on this, I'd appreciate it!

Sub reduce_nodes()
    ActiveDocument.BeginCommandGroup "Reduce nodes and outline"
    
    Dim reduceRange As ShapeRange
    Dim reduceSh As Shape
       
    Set reduceRange = ActiveSelectionRange
         
    ActiveTool = cdrToolNodeEdit
     
    For Each reduceSh In reduceRange.Shapes
    
        If (reduceSh.IsSimpleShape = True) Then
            reduceSh.ConvertToCurves
        End If
            
        reduceSh.Curve.Nodes.All.CreateSelection
            
        ActiveWindow.Activate
        ' Invoke the "Reduce Nodes" button directly
        Application.FrameWork.Automation.InvokeItem "b714bc06-7325-4d33-b330-4f4efec22c91"
        reduceSh.Fill.ApplyNoFill
        reduceSh.Outline.SetProperties Color:=CreateRGBColor(0, 0, 255)
        
    Next reduceSh
    
    ActiveDocument.EndCommandGroup
End Sub