Quantcast
Channel: MicroStation Programming Forum - Recent Threads
Viewing all articles
Browse latest Browse all 7260

RE: Change dimension with VBA, kind of working

$
0
0

I've simplified the code a little bit but still have the same problem.

Once oDimension.DimensionStyle = oDimstyle to change .PrimaryAccuracy has been used it doesn't work anymore.

So if I used this code on a single dimension to add decimal points:

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

    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
                If Not oDimstyle.PrimaryAccuracy = msdDimAccuracy3 Then
                    oDimstyle.PrimaryAccuracy = msdDimAccuracy3
                End If
                If oDimstyle.ShowPrimaryTrailingZeros = True Then
                    oDimstyle.ShowPrimaryTrailingZeros = False
                End If
                oDimension.DimensionStyle = oDimstyle
                oDimension.Rewrite
                oDimension.Redraw
            Next i
        Loop
    End If
End Sub

And then this code because I changed my mind and no longer need said decimal points:

Sub DIMremacc()

    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

    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
                If Not oDimstyle.PrimaryAccuracy = msdDimAccuracy0 Then
                    oDimstyle.PrimaryAccuracy = msdDimAccuracy0
                End If
                If oDimstyle.ShowPrimaryTrailingZeros = True Then
                    oDimstyle.ShowPrimaryTrailingZeros = False
                End If
                oDimension.DimensionStyle = oDimstyle
                oDimension.Rewrite
                oDimension.Redraw
            Next i
        Loop
    End If
End Sub

Code doesn't work the second time. I have to use the change dimension tool. 

Hope this explains my problem better.

Regards,

Josh


Viewing all articles
Browse latest Browse all 7260

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>