Lập trình VBA MicroStation V8i

I have the object is the default Angle cell is 0 ° I want to rotate the object to the horizontal that coincides with the X axis of Microstaion V8i, 

My idea is to select objects using MicroStation V8i selection tool
This can be handled by VBA Microstation, hope everyone in the forum help me, thank you very much


Parents
  • Hi,

    as Jon wrote, if there is no a specific reason to use VBA, it's probably better to ask in MicroStation Forum and to discuss how to do it using normal MicroStation tools.

    I have the object is the default Angle cell is 0 ° I want to rotate the object to the horizontal that coincides with the X axis of Microstaion V8i, 

    On the other hand, based on this information, I am not quite sure whether it can be solved by user tool only.

    I recommend to share an example file. If 0° is the first (rotated) text, it will require to analyse text inside the cell and to rotate the cell in an opposite direction, where VBA will be required.

    With regards,

      Jan

  • It's like rotating using the V8i' RE command, but Re does not rotate multiple objects at once, I want to use VBA to rotate multiple objects at once, by selecting select then VBA will automatically rotate the object. in the north, because I do not know about programming so I can not write it myself, I hope people help me to save more time. I have the v8i file attached to this link. Best regards

    www.mediafire.com/.../DC03.dgn

  • I like to use a macro I found on the askinga part of this website called Active Angle Assistant.  I think it does what you want.

    Code... We're the good guys now.

  • Hi Doan,

    thanks for the file, it's as I expected: The worse scenario where cell are unrotated but texts inside cells are rotated randomly. I am curious how such drawing was created?

    This code should work, but be aware it's just quickly written draft:

    Option Explicit
    
    Public Sub RotateCell()
        ProcessAllCellsInActiveModel
    End Sub
    
    Private Sub ProcessAllCellsInActiveModel()
        Dim ee As ElementEnumerator
        Set ee = GetCellsInActiveModel
    
        Do While ee.MoveNext
            If ee.Current.Type = msdElementTypeCellHeader Then
                ProcessCell ee.Current.AsCellElement
            End If
        Loop
    End Sub
    
    Private Function GetCellsInActiveModel() As ElementEnumerator
        Dim esc As ElementScanCriteria
        Set esc = CreateScanCriteriaCellsOnly
    
        Dim ee As ElementEnumerator
        Set ee = ActiveModelReference.Scan(esc)
        
        Set GetCellsInActiveModel = ee
    End Function
    
    Private Function CreateScanCriteriaCellsOnly() As ElementScanCriteria
        Dim esc As New ElementScanCriteria
        esc.ExcludeAllTypes
        esc.IncludeType msdElementTypeCellHeader
    
        Set CreateScanCriteriaCellsOnly = esc
    End Function
    
    Private Sub ProcessCell(cell As CellElement)
        Dim textInCellRotation As Double
        textInCellRotation = AnalyzeTextAngleInCell(cell)
    
        Dim inversionRotation As Double
        inversionRotation = textInCellRotation * -1
        
        cell.RotateAboutZ cell.Origin, inversionRotation
        cell.Rewrite
    End Sub
    
    Private Function AnalyzeTextAngleInCell(cell As CellElement) As Double
        Dim ee As ElementEnumerator
        Set ee = cell.Drop
        
        Do While ee.MoveNext
            If ee.Current.Type = msdElementTypeText Then
                Dim textRotation As Matrix3d
                textRotation = ee.Current.AsTextElement.rotation
                
                Dim rotX As Double, rotY As Double, rotZ As Double, scl As Double
                Matrix3dIsXRotationYRotationZRotationScale textRotation, rotX, rotY, rotZ, scl
                AnalyzeTextAngleInCell = rotZ
                Exit Function
            End If
        Loop
        
        AnalyzeTextAngleInCell = 0
    End Function
    

    With regards,

      Jan

Reply
  • Hi Doan,

    thanks for the file, it's as I expected: The worse scenario where cell are unrotated but texts inside cells are rotated randomly. I am curious how such drawing was created?

    This code should work, but be aware it's just quickly written draft:

    Option Explicit
    
    Public Sub RotateCell()
        ProcessAllCellsInActiveModel
    End Sub
    
    Private Sub ProcessAllCellsInActiveModel()
        Dim ee As ElementEnumerator
        Set ee = GetCellsInActiveModel
    
        Do While ee.MoveNext
            If ee.Current.Type = msdElementTypeCellHeader Then
                ProcessCell ee.Current.AsCellElement
            End If
        Loop
    End Sub
    
    Private Function GetCellsInActiveModel() As ElementEnumerator
        Dim esc As ElementScanCriteria
        Set esc = CreateScanCriteriaCellsOnly
    
        Dim ee As ElementEnumerator
        Set ee = ActiveModelReference.Scan(esc)
        
        Set GetCellsInActiveModel = ee
    End Function
    
    Private Function CreateScanCriteriaCellsOnly() As ElementScanCriteria
        Dim esc As New ElementScanCriteria
        esc.ExcludeAllTypes
        esc.IncludeType msdElementTypeCellHeader
    
        Set CreateScanCriteriaCellsOnly = esc
    End Function
    
    Private Sub ProcessCell(cell As CellElement)
        Dim textInCellRotation As Double
        textInCellRotation = AnalyzeTextAngleInCell(cell)
    
        Dim inversionRotation As Double
        inversionRotation = textInCellRotation * -1
        
        cell.RotateAboutZ cell.Origin, inversionRotation
        cell.Rewrite
    End Sub
    
    Private Function AnalyzeTextAngleInCell(cell As CellElement) As Double
        Dim ee As ElementEnumerator
        Set ee = cell.Drop
        
        Do While ee.MoveNext
            If ee.Current.Type = msdElementTypeText Then
                Dim textRotation As Matrix3d
                textRotation = ee.Current.AsTextElement.rotation
                
                Dim rotX As Double, rotY As Double, rotZ As Double, scl As Double
                Matrix3dIsXRotationYRotationZRotationScale textRotation, rotX, rotY, rotZ, scl
                AnalyzeTextAngleInCell = rotZ
                Exit Function
            End If
        Loop
        
        AnalyzeTextAngleInCell = 0
    End Function
    

    With regards,

      Jan

Children