[v8i SS3 VBA] Place dimension doesn't work as expected

Hello,

I’m developing a little module for drawing elements from a data file. My problem is that Microstation doesn’t create Dimension Elements as I expect.

My Dimension Elements are very simple. They must give the measure between two points and match a custom style given by its name. This is the code I use:

'

' Imports a DimensionElement.

'

Function GetDimensionElement(segment() As Point3d, StyleName As String) As Element

    Dim oDimElem As DimensionElement

    Dim oDimStyle As DimensionStyle

    Dim i As Integer

    Set oDimElem = CreateDimensionElement1(Nothing, Matrix3dIdentity, msdDimTypeCustomLinear)

    Set oDimStyle = ActiveDesignFile.DimensionStyles(StyleName)

    If IsNothing(oDimStyle) Then

        Set oDimStyle = ActiveDesignFile.DimensionStyles(1)

    End If

   

    For i = 0 To UBound(segment)

        oDimElem.AddReferencePoint ActiveModelReference, segment(i)

    Next i

    Set GetDimensionElement = oDimElem

End Function

When I must get a dimension like this:

I have something like this:

It seems that Dimension Style has design or view alignment, but it doesn’t. It’s true alignment.

I’ve tried too modifying some properties after and before creation, without success.

Any suggestion will be appreciated.

Regards,

Javier Rufas


  • I found you created an oDimElem and an oDimStyle but I can't find the code you set oDimStyle to oDimElem. So I think you miss a below line:

    oDimElem.DimensionStyle = oDimStyle

    HTH, YongAn



  • I forget a little detail. I've lost a:

    Set oDimelem.DimensionStyle = oDimStyle 

    But that doesn't work.

    And changing Type doesn't too. This is the last code:

    '
    ' Imports a DimensionElement.
    '
    Function GetDimensionElement(segment() As Point3d, StyleName As String) As Element
      Dim oDimElem As DimensionElement
      Dim oDimStyle As DimensionStyle
      Dim i As Integer

      Set oDimStyle = ActiveDesignFile.DimensionStyles(StyleName)

      ' If StyleName doesn't exist, get Active Style
      If IsNothing(oDimStyle) Then
        Set oDimStyle = ActiveSettings.DimensionStyle
      Else
        ' Set Active Style to StyleName
        Set ActiveSettings.DimensionStyle = oDimStyle
      End If

      ' Create Dimension element with ... Active Dimension Style?
      Set oDimElem = CreateDimensionElement1(Nothing, Matrix3dIdentity, msdDimTypeUseActive)

      'Force Dimension Style
      'Set oDimElem.DimensionStyle = oDimStyle

      For i = LBound(segment) To UBound(segment)
        oDimElem.AddReferencePoint ActiveModelReference, segment(i)
      Next i

      Set GetDimensionElement = oDimElem
    End Function

  • Hi Yongan.Fu,

    Thank you for your answer, but that doesn't work too.

    Now, I supect that I must give to CreateDimensionElement1 the correct RotationMatrix.

    I interpreted that it's an additional element trasnformation, but I'll build a RotationMatrix from segment  ... and I'll see.

  • SOLVED.

    It was the rotation matrix (I don't know that happens if It creates a dimension element for a Linestring with more of two points).

    Te Final code is:

    '
    ' Imports a DimensionElement.
    '
    Function GetDimensionElement(segment() As Point3d, StyleName As String) As Element
    Dim oDimElem As DimensionElement
    Dim oDimStyle As DimensionStyle
    Dim RotationMatrix As Matrix3d
    Dim i As Integer

    Set oDimStyle = ActiveDesignFile.DimensionStyles(StyleName)

    ' If StyleName doesn't exist, get Active Style
    If IsNothing(oDimStyle) Then
    Set oDimStyle = ActiveSettings.DimensionStyle
    Else
    ' Set Active Style to StyleName
    Set ActiveSettings.DimensionStyle = oDimStyle
    End If

    RotationMatrix = Matrix3dFromAxisAndRotationAngle(2, GetActiveAngleFrom2Points(segment(0), segment(1)))

    ' Create Dimension element with ... Active Dimension Style?
    Set oDimElem = CreateDimensionElement1(Nothing, RotationMatrix, msdDimTypeUseActive)

    'Force Dimension Style
    'Set oDimElem.DimensionStyle = oDimStyle

    For i = LBound(segment) To UBound(segment)
    oDimElem.AddReferencePoint ActiveModelReference, segment(i)
    Next i

    Set GetDimensionElement = oDimElem
    End Function

     

    'Modified from VBA Help

    Function GetActiveAngleFrom2Points(pt1 As Point3d, pt2 As Point3d) As Double
    Dim vec1 As Vector3d, vec2 As Vector3d
    Dim angle As Double

    'get vectors in plane of view
    vec1 = Vector3dSubtractPoint3dPoint3d(pt2, pt1)
    vec2 = Vector3dFromXY(1#, 0#)

    'duplicate keyin logic
    angle = Vector3dAngleBetweenVectorsXY(vec2, vec1)

    GetActiveAngleFrom2Points = angle
    End Function

    Answer Verified By: Javier Rufas