I make a selection (top) and then run my macro and though the macro does fine it leaves the selection in this state (bottom) whereby requiring me to deselect and select again
What is my code missing?
Sub BreakDimensions()Optimization = TrueActiveDocument.BeginCommandGroup "BreakDimension" Dim sr As ShapeRange, s As Shape Set sr = ActiveSelectionRange For Each s In sr If Not s.Type = cdrLinearDimensionShape Then s.RemoveFromSelection End If Next s ActiveSelection.BreakApart sr.AddToSelection sr.Group Optimization = False ActiveDocument.EndCommandGroup End Sub
What are you trying to accomplish, Myron?
Break apart Dimension 1, and group the resulting pieces? Then break apart Dimension 2, and group the resulting pieces? And so on?
Suppose to loop thru and break all dimensions in the selected then group the whole mess
Do you finally need a group of all dimensions segments?
When you use BreakApart only the dimension curves ar broken. The dimension itself is composed from curves and an Artistic Text. This one will not be selected when you break apart the dimension.
Besides all that, if I understool well what you mean, I think there is no need of selection. If you use BreakApartEx instead of BreakApart. Like in the next example:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
Sub BreakDimensions_bis() Dim sr As ShapeRange, s As Shape, srBis As ShapeRange, sGr As Shape, i As Long Set sr = ActiveSelectionRange For Each s In sr If Not s.Type = cdrLinearDimensionShape Then sr.Remove sr.IndexOf(s) 'ArtisticText of each dimension is Removed... i = i + 1 End If Next s Debug.Print i & " shapes removed" Set srBis = sr.BreakApartEx Set sGr = srBis.Group sGr.Name = "Whatever" ActiveDocument.ClearSelection: sGr.CreateSelection End Sub
Forget about Optimization in this case...
For-Next loop can probably be replaced by
Set sr = ActiveSelectionRange.FindShapes(, cdrLinearDimensionShape )