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
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)
Loop
End Sub