Sub DimensionsToFTNew()Dim sr As New ShapeRange, s As Shape For Each s In ActivePage.FindShapes(Type:=cdrLinearDimensionShape) sr.Add s s.Dimension.Linear.Units = cdrDimensionUnitFT Next sEnd Sub
I've tested it out with the example code and tried to find some work around... but sadly no luck. Seems programmatically setting the units for linear dimensions is bugged? Always seems to inherit the default settings.
Best I could think of was breaking the dim and converting the text manually. Not ideal but might get you out of manually converting loads of dimensions.
Sub LDConverter() 'Converts mm dims to feet ActiveDocument.Unit = cdrMillimeter Dim SR As ShapeRange, S As Shape Dim GROUPER As Shape Dim TS As Shape, Str As String, Conv As Double Dim TXC#, TYC# For Each S In ActivePage.FindShapes(Type:=cdrLinearDimensionShape) Set TS = S.Dimension.TextShape If Right(TS.Text.Story, 3) = " mm" Then Set SR = S.BreakApartEx Str = TS.Text.Story TXC = TS.CenterX TYC = TS.CenterY Conv = CDbl(Left(Str, Len(Str) - 3)) Conv = Round((Conv * 0.00328084), 1) TS.Text.AlignProperties.Alignment = cdrNoAlignment TS.Text.Story = Conv & " ft" TS.SetPositionEx cdrCenter, TXC, TYC SR.Add TS Set GROUPER = SR.Group End If Next S End Sub