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