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.EndCommandGroupEnd Sub
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
Not necessary to 'invoke' the shape tool to run the auto reduce.
Just run the autoreduce on the shapes.
Sub reduce_nodes()Dim s As ShapeIf ActiveSelectionRange.Count = 0 Then: Exit SubActiveDocument.BeginCommandGroup "Reduce nodes and outline"For Each s In ActiveSelection.Shapes If s.Type <> cdrCurveShape Then s.ConvertToCurves s.Curve.AutoReduceNodesNext sActiveDocument.EndCommandGroupEnd Sub
My gosh, was I ever over-thinking that!
Thank you for the solution; my old sub has now found its place in the rubbish bin.