Hello Community
Having a small problem when working with dimensions. I'm currently writing a few small dimension programs just to streamline workflow and to possibly add to batch setup later but I've run into a problem that I cant seem to solve.
As an example I've written this code to change the primary accuracy of selected dimensions to 3 decimal points but to exclude zeros at the end.
eg. 78.760 would be shown as 78.76, 87.000 as 87 and so on.
The problem I'm having is that once I've run the program on a dimension and changed the primary accuracy, eg 78 to 78.76, but the dimension length changes for whatever reason, the program can no longer change the primary accuracy again. Its as if after the dimension primary accuracy has been rewritten it becomes read-only or something.
Having the same problem when changing the .showsecondarytext once turned on programmatically I can not turn it off programmatically.
If I then use change dimension tool the programs work again.
Macro Below
Sub DIMchaacc()
Dim startPoint As Point3d
Dim point As Point3d, point2 As Point3d
Dim lngTemp As Long
Dim oDimensions As ElementEnumerator
Dim oDimension As DimensionElement
Dim oDimstyle As DimensionStyle
Dim oValue As String
Dim oRound As String
Dim O As Integer
If ActiveModelReference.AnyElementsSelected Then
Set oDimensions = ActiveModelReference.GetSelectedElements
Do While oDimensions.MoveNext
Set oDimension = oDimensions.Current
For i = 1 To oDimension.SegmentsCount
Set oDimstyle = oDimension.DimensionStyle
oValue = oDimension.ActualValue(i)
If oDimstyle.PrimaryMasterUnitLabel = "mm" Then
oValue = oValue * 1000
oValue = Round(oValue, 3)
oRound = Mid(oValue, InStr(oValue, ".") + 1)
O = Len(oRound)
If O = 0 Then
oDimstyle.PrimaryAccuracy = msdDimAccuracy0
Else
If O = 1 Then
oDimstyle.PrimaryAccuracy = msdDimAccuracy1
Else
If O = 2 Then
oDimstyle.PrimaryAccuracy = msdDimAccuracy2
Else
If O = 3 Then
oDimstyle.PrimaryAccuracy = msdDimAccuracy3
End If
End If
End If
End If
oDimension.DimensionStyle = oDimstyle
oDimension.Rewrite
oDimension.Redraw
End If
Next i
Loop
End If
End Sub
Any help would be great.
Thanks
Josh