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
Unknown said:The code below works fine until I try to access any array with tag elements
I suggest that you move your code into a MicroStation VBA macro. See if it works there, before attempting to control MicroStation from Excel. If it doesn't work in MicroStation VBA, it definitely won't work in Excel VBA.
Regards, Jon Summers LA Solutions
Jon, Jan,
After stripping out the code (.filedialog doesn't work with MS anyway) and running it with already open dgn, it works fine. I will upload tomorrow the library with questionable cell.
Option Explicit Dim directory As String, fileName As String Sub ImportStart_Click() 'PROGRAM START obslugaDGN 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() '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 MsgBox "yes" '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) 'Set fldr = Application.fo '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 Jon and Jan for all your input. If you have any suggestion how to find and hold tag sets by value of one tag, please let me know
Unknown said: If you have any suggestion how to find and hold tag sets
This article about Reading and Writing Tag Data may help.
This article about Text Search & Replace describes a project that works with text, text node and tag elements.
Unknown said:This article about Reading and Writing Tag Data may help.
I've already linked your article in a reply above, easy to miss due to the new thread layout which I personally dislike.
Here is visual confirmation of my findings:
Of course I saw your article Reading and Writing Tag Data and actually those codes inspired me to write my own program. Unfortunately for some reason links to your website did not work from google search. I pulled them from "cached" but I was not able to download those macros. Since there is no simple answer to my issue, I am going to reorganize this program tomorrow and see what happens. I appreciate your help. You are the best!
Is there any way to get access to tag values (read/write) through setting object on tagsets?
Set oTagSets = ActiveDesignFile.TagSets
Unknown said:Is there any way to get access to tag values hrough tagsets?
No: a DGN file contains tag set definitions. Those definitions are meta-data that describe the data you want to store using tag elements. The analogy is a relational database schema, which describes the table structure of a database.
Thanks Jon, that is what I thought. I have been trying various combinations of .GetTags() but Excel crashes every time when I am trying access the array. I am thinking of linking somehow the array scanned with msdElementTypeTag criteria and object ActiveDesignFile.TagSets. That would allow me to group my tag elements by corresponding tagset definition. The other thought I have is to find some unique ID which is common for all tag elements within tagset but different for other the same tagsets in the same drawing
Darius,
Unknown said: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.
Consider the image below and the following approach:
After your code finds a cell and detects an sub element within the cell has tags, check if the tag's TagSetName property matches the value in Cell A1. If it does, check each TagDefinitionName property and loop through each value in cells B1 to 'whatever'1. If you find a match change the TagElement's .value property to the value contained in the cell below.