Get information from 1 cell in a nested cell

Hi!

I have a cell with 2 cells in it.

1 of these cells have textnodes with textinformation.

Now i want to get the origo of the cell (works), the name of the cell (works), and the texts from the textnodes in one of the nested cell (doesn't work).

It's 2 different texts that both have different fonts so that it could be "easy" to know wich one to write out when. 

So i want to get something like,

enumerator.Current.AsCellElement.GetSubElements.Current.AsCellElement.GetSubElements.Current.IsTextnodeElement. (I know it wont work, but it explains what I want to do)

Here is the sub where i want all that to happen.

 

Public Sub raknabrunnceller()
    
    Dim pMatris() As Variant
    Dim pRad As Long
    pRad = 0 'Rad i matris
   
    '  Resize the matrix, keeping the existing values.
    ReDim Preserve pMatris(6, pRad) As Variant
    pMatris(0, pRad) = "X"
    pMatris(1, pRad) = "Y"
    pMatris(2, pRad) = "Z"
    pMatris(3, pRad) = "Cellnamn"
    pMatris(4, pRad) = "Level"
    pMatris(5, pRad) = "Numrering (enl ritn)"
    pMatris(6, pRad) = "Namn"
   
   
    Dim enumeratorCell As ElementEnumerator
    Dim oScanCriteriaCell As New ElementScanCriteria
    Dim oText As Element


    Set oLevel = ActiveDesignFile.Levels(pAktuelltlager)
    Set textLevel = ActiveDesignFile.Levels(pAktullttextlager)
   
    oScanCriteriaCell.ExcludeAllTypes
    oScanCriteriaCell.ExcludeAllLevels
    oScanCriteriaCell.IncludeType msdElementTypeCellHeader
    'oScanCriteriaCell.IncludeType msdElementTypeText
    'oScanCriteriaCell.IncludeType msdElementTypeTextNode
    oScanCriteriaCell.IncludeLevel oLevel
    oScanCriteriaCell.IncludeLevel textLevel
    Set enumeratorCell = ActiveModelReference.Scan(oScanCriteriaCell)
    
    Do
        Do While enumeratorCell.MoveNext
            oPoint = enumeratorCell.Current.AsCellElement.Origin
            pCellNamn = enumeratorCell.Current.AsCellElement.Name
            
            While enumeratorCell.Current.AsCellElement.IsCellElement
                    Set oText = enumeratorCell.Current.AsCellElement.GetSubElements
                    'If enumeratorCell.Current.AsCellElement.GetSubElements.Current.AsCellElement.GetSubElements.Current.IsTextNodeElement > 0 Then
                    ....

                    'End If
            Wend
               
            If LastoPoint.X <> oPoint.X And LastoPoint.Y <> oPoint.Y Then 'Ta bort onödiga kopior
                pRad = pRad + 1 ' Nästa rad i matris och numrering
                '  Resize the matrix, keeping the existing values.
                ReDim Preserve pMatris(6, pRad) As Variant
                pMatris(0, pRad) = oPoint.X
                pMatris(1, pRad) = oPoint.Y
                pMatris(2, pRad) = oPoint.Z
                pMatris(3, pRad) = pCellNamn
                pMatris(4, pRad) = pAktuelltlager
                pMatris(5, pRad) = pRad
                pMatris(6, pRad) = "Namn"
                          
            End If
            LastoPoint.X = oPoint.X
            LastoPoint.Y = oPoint.Y
        Loop
    Loop Until MoveNext = False

 

I have attached a sample DGN with the cells that I want to get the text out of.

 

Best Regards

Oscar Carlsson

Cellsample.dgn
Parents
  • Try this

    Hugues

    Sub ScanForText()

            Dim oElement As Element
            Dim oEnumerator As ElementEnumerator
            Dim oScanCriteria As New ElementScanCriteria
           
            Dim cellName As String

            '/======================================================
            '/  Define scanCriteria
            '/======================================================
            oScanCriteria.Reset
            oScanCriteria.ExcludeAllTypes
            oScanCriteria.IncludeType msdElementTypeCellHeader
            '/======================================================================================

            Set oEnumerator = ActiveModelReference.Scan(oScanCriteria)

            While oEnumerator.MoveNext
                Set oElement = oEnumerator.Current
               
                cellName = oElement.AsCellElement.name

                Select Case oElement.Type

                    Case msdElementTypeCellHeader
                    cellName = oElement.AsCellElement.name

                        Call scanInCell_List(oElement)

                End Select

            Wend
           
    End Sub

    Sub scanInCell_List(oElement As Element)

            Dim oCellElemEnum As ElementEnumerator  ' Enumerator for Cell Elements
            Dim oElement2 As Element
            Dim nameoElement As String
           
            Dim myTextNode As TextNodeElement
            Dim eeTextNode As MicroStationDGN.ElementEnumerator
           
            Dim myText As String
              
            Set oCellElemEnum = oElement.AsCellElement.GetSubElements

            Do While oCellElemEnum.MoveNext
           
            Set oElement2 = oCellElemEnum.Current
         
             
                Select Case oCellElemEnum.Current.Type
       

                   Case msdElementTypeTextNode
                   
                    Set myTextNode = oElement2.AsTextNodeElement
                  
                    Set eeTextNode = myTextNode.GetSubElements
                  
                                    Do While eeTextNode.MoveNext
                                        With eeTextNode.Current.AsTextElement
                                          
                                            MsgBox .Text
      
                                        End With
                                    Loop
                                      
                    
                    Case msdElementTypeCellHeader
                   
                    nameoElement = oElement2.AsCellElement.name

                        Call scanInCell_List(oElement2)

                End Select

            Loop

    End Sub

Reply
  • Try this

    Hugues

    Sub ScanForText()

            Dim oElement As Element
            Dim oEnumerator As ElementEnumerator
            Dim oScanCriteria As New ElementScanCriteria
           
            Dim cellName As String

            '/======================================================
            '/  Define scanCriteria
            '/======================================================
            oScanCriteria.Reset
            oScanCriteria.ExcludeAllTypes
            oScanCriteria.IncludeType msdElementTypeCellHeader
            '/======================================================================================

            Set oEnumerator = ActiveModelReference.Scan(oScanCriteria)

            While oEnumerator.MoveNext
                Set oElement = oEnumerator.Current
               
                cellName = oElement.AsCellElement.name

                Select Case oElement.Type

                    Case msdElementTypeCellHeader
                    cellName = oElement.AsCellElement.name

                        Call scanInCell_List(oElement)

                End Select

            Wend
           
    End Sub

    Sub scanInCell_List(oElement As Element)

            Dim oCellElemEnum As ElementEnumerator  ' Enumerator for Cell Elements
            Dim oElement2 As Element
            Dim nameoElement As String
           
            Dim myTextNode As TextNodeElement
            Dim eeTextNode As MicroStationDGN.ElementEnumerator
           
            Dim myText As String
              
            Set oCellElemEnum = oElement.AsCellElement.GetSubElements

            Do While oCellElemEnum.MoveNext
           
            Set oElement2 = oCellElemEnum.Current
         
             
                Select Case oCellElemEnum.Current.Type
       

                   Case msdElementTypeTextNode
                   
                    Set myTextNode = oElement2.AsTextNodeElement
                  
                    Set eeTextNode = myTextNode.GetSubElements
                  
                                    Do While eeTextNode.MoveNext
                                        With eeTextNode.Current.AsTextElement
                                          
                                            MsgBox .Text
      
                                        End With
                                    Loop
                                      
                    
                    Case msdElementTypeCellHeader
                   
                    nameoElement = oElement2.AsCellElement.name

                        Call scanInCell_List(oElement2)

                End Select

            Loop

    End Sub

Children
No Data