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
So, besides the dimensions do you need moving of some other previous selected shapes?
I did not understand it from your initial post. Wouldn't they be also broken apart? Isn't that important?
If yes you can filter what to be eliminated from sr.shapes (in my code suggestion( acording to some criteria. Name or Object Data like this:
Creating the property:
ActiveDocument.DataFields.Add "ToBeSelected" ActiveShape.ObjectData("ToBeSelected").Value = "True"
And returning/using it: Debug.Print ActiveShape.ObjectData("ToBeSelected")
Initially I would use a macro to create this property to all shapes I would like to be collected in the final group, I would not use selection at all and I would create a shape range using CQL or simply iterate through all shapes and selecting the ones necessary to be used.
That's what I explained in my original post. The macro works perfectly as I have except that it finishing in a different grouped state as expected. It has round selection glyphs instead of the usual squares
Myron said:I have the macro to break the dimensions of the selected then group it all so I can resize it without screwing up the dimensions
BTW, why do you need to break dimensions when you can simply disable their automatic change ?
After this you can resize source shape without screwing up the dimensions, size numbers will remain the same
In my original post I forgot to add the image that explained.
try modified code
Sub BreakDimensions()Optimization = TrueActiveDocument.BeginCommandGroup "BreakDimension"Dim sr As ShapeRange, s As ShapeSet sr = ActiveSelectionRangeFor Each s In srIf Not s.Type = cdrLinearDimensionShape Thens.RemoveFromSelectionEnd IfNext sActiveSelection.BreakApartsr.AddToSelection
Rem sr.GroupActiveSelection.Group
Optimization = FalseActiveDocument.EndCommandGroupEnd Sub