Hi,
I have been trying to write an Excel VBA macro which:
1. opens all .dgn files from selected location
2.scans for all cell elements in active model
3. builds an array with found cells
4. checks if cells have tags
5. if 4 true then builds arrays with tag elements for each cell
The code below works fine until I try to access any array with tag elements. Any operation like reading or writing of any tag element array causes Excel crash every time. Excel stops working and restarts with any other error message. The tag element arrays are created correctly because I can see them in watch window while I stop program before the "crashing" program line. There are some suspicious value in the tag element array like "Subtype- attempting to perform a non-graphical operation on graphical element". Any help would be appreciated.
Option Explicit Dim directory As String, fileName As String Sub ImportStart_Click() 'PROGRAM START ExportTexts End Sub Sub ExportTexts() 'On Error Resume Next directory = GetFolder("c:\") & "\" fileName = Dir(directory & "*.dgn") Do While fileName <> "" obslugaDGN (directory & fileName) fileName = Dir Loop MsgBox "Done", vbOKOnly End Sub Sub obslugaDGN(plik As String) Dim myDGN As DesignFile Dim oAL As ApplicationObjectConnector Set oAL = New MicroStationDGN.ApplicationObjectConnector Set myDGN = oAL.Application.OpenDesignFile(plik, False) Dim ee As ElementEnumerator Dim es As ElementScanCriteria Dim elArray() As element Dim i, j As Integer Set es = New ElementScanCriteria es.ExcludeAllTypes es.IncludeType msdElementTypeCellHeader es.IncludeType msdElementTypeSharedCell Set ee = ActiveModelReference.Scan(es) elArray = ee.BuildArrayFromContents For i = LBound(elArray) To UBound(elArray) If (elArray(i).HasAnyTags) Then Dim oTags() As TagElement oTags = elArray(i).GetTags() For j = LBound(oTags) To UBound(oTags) If oTags(j).TagDefinitionName = "TAG" Then 'here Excel stops working and restarts 'procedure.... End If Next j End If Next i myDGN.Close Set myDGN = Nothing Set ee = Nothing End Sub Function GetFolder(strPath As String) As String ' function gets folder picked by user Dim fldr As FileDialog Dim sItem As String Set fldr = Application.FileDialog(msoFileDialogFolderPicker) With fldr .Title = "Select a Folder" .AllowMultiSelect = False .InitialFileName = strPath If .Show <> -1 Then GoTo NextCode sItem = .SelectedItems(1) End With NextCode: GetFolder = sItem Set fldr = Nothing End Function
Thanks,
Darius
Try changing Dim oTags() As TagElement to Dim oTags() As Variant
"Can't assign to array" Compile error
I can't speak for others but I have never had success using GetTags(). Instead I prefer not to scan for specific host elements (in your case, Normal and shared cells) but instead target the tag elements themselves i.e. instead of:
es.IncludeType msdElementTypeCellHeader es.IncludeType msdElementTypeSharedCell
try using:
es.IncludeType msdElementTypeTag
This will unlikely work with your existing code as is so you will probably need to edit your loop code suit the new scan element type.
Yes, I could use msdElementTypeTag but I do not know how to group all tags by cell they are attached to. There is the parent parameter but it seems to be empty. Please note that one drawing may have 2 or more the same cells with the same tag set attached. The goal is to update all tags of the tagset if the value of one tag meets my criteria.