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 FunctionThanks,
Darius
