I have created a program which will go through all my DGN drawings that are in many sub folders in a Master Folder. ( Example: C:/MasterFolder/Subfolder/1234.DGN)
My program goes through each element looking for specific cell name and when it does find it, it will retrieve the origin X & Y points. Using the Record macro and changing a bit of the code, it will replace the cell with the new cell at the same location retrieved earlier.
Now i am updating about 12,000+ DGN files, and for every file, every cell it finds, it opens up the cell library window so it can do a "placement". I can only get to about 36 jobs before either the macro or microstation enters the "Not Responding" phase, and gets stuck in that phase and does not continue on until i force quit the program. I suspect the cell library window being opened too frequent and too fast so microstation can not keep up and freezes/crashes. Is there a way i can do this same technique/method without it freezing? could i use something called keyins? The best would be if someone knows another way of doing a "Placement" on a cell without opening the cell library window, that might fix the problem.
i have a form with a button and two labels, i click the button, a window pops up asking me to select the "Master Folder", click ok. then the program starts running. there are 10 cells i wanna replace, for each cell it will go through all DGN files in the sub folders. so let's say 10 cells X 12,000 .... so 120,000 files. This is how my program works.
i have a userform1 (excel), and a class module Macro1ModalHandler.
I have posted my code below:
Userform1:
Option Explicit Dim counter As Integer Dim xcoord, ycoord As Integer Dim CellName As Variant Dim i As Double Private Sub CommandButton1_Click() On Error Resume Next: 'this chunk of code opens up a new window for users to select the folder which the files are in Dim myFSO As New Scripting.FileSystemObject Dim myFolder As Scripting.Folder Dim myFile As Scripting.File Dim myFoldering As Scripting.Folder Dim myShell As New Shell32.Shell Dim myRootFolder As Shell32.Folder3 Set myRootFolder = myShell.BrowseForFolder(0, "Pick", 0) If myRootFolder Is Nothing Then Exit Sub Set myFolder = myFSO.GetFolder(myRootFolder.Self.Path) Dim FSOS As New FileSystemObject Dim myFolderS As Folder Dim mySubFolderS As Folder Set myFolderS = myFSO.GetFolder(myRootFolder.Self.Path) For Each mySubFolderS In myFolderS.SubFolders For Each myFile In mySubFolderS.Files Select Case UCase(Right(myFile.Name, 3)) Case "DGN" OpenDesignFile myFile.Path, False, msdV7ActionWorkmode Label1.Caption = myFile.Path For i = 1 To 10 Step 1 If i = 1 Then CellName = "16041" If i = 2 Then CellName = "1604" If i = 3 Then CellName = "16042" If i = 4 Then CellName = "160422" If i = 5 Then CellName = "160423" If i = 6 Then CellName = "B50031" If i = 7 Then CellName = "B50032" If i = 8 Then CellName = "B50033" If i = 9 Then CellName = "B4003C" If i = 10 Then CellName = "B4003O" Call getting Next i CadInputQueue.SendCommand "FILEDESIGN" End Select Next Next MsgBox "finished" End Sub Sub getting() Dim oCriteria As New ElementScanCriteria Dim oCriteriaText As New ElementScanCriteria Dim ee As ElementEnumerator 'ElementEnumerator is how it is able to search through the entire model for a specific element Dim et As ElementEnumerator Dim tc As CellElement Dim myTextNode As TextNodeElement Dim myTextNode1 As TextNodeElement Dim myTextNode2 As TextNodeElement Dim myTextNode3 As TextNodeElement Dim tf As Element Dim target As TextElement Dim IDholder As DLong oCriteria.ExcludeAllTypes oCriteria.IncludeType msdElementTypeCellHeader oCriteria.IncludeType msdElementTypeSharedCell 'searches for references that fits the criteria ( type header, and shared cell) and sets it as ee Set ee = ActiveModelReference.Scan(oCriteria) Do While ee.MoveNext If ee.Current.AsCellElement.Name = CStr(CellName) Then '<------name this something different for different changes oCriteria.ExcludeAllTypes oCriteria.IncludeType msdElementTypeCellHeader oCriteria.IncludeType msdElementTypeSharedCell oCriteria.IncludeOnlyCell CStr(CellName) '<------name this something different for different changes End If Loop Set ee = ActiveModelReference.Scan(oCriteria) ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'DO NOT CHANGE SCALING FACTORS/NUMBER UNLESS NECESSARY Do While ee.MoveNext Set tc = ee.Current tc.ResetElementEnumeration xcoord = tc.Origin.X ycoord = tc.Origin.Y Call stuff Loop End Sub Sub stuff() Dim startPoint As Point3d Dim point As Point3d, point2 As Point3d Dim lngTemp As Long ' Start a command CadInputQueue.SendCommand "DIALOG CELLMAINTENANCE TOGGLE" Dim modalHandler As New Macro1ModalHandler AddModalDialogEventsHandler modalHandler ' The following statement opens modal dialog "Attach Cell Library" CadInputQueue.SendCommand "ATTACH LIBRARY" ' Set a variable associated with a dialog box SetCExpressionValue "tcb->activeCell", CStr(CellName), "" CadInputQueue.SendCommand "REPLACE CELLS EXTENDED" ' Coordinates are in master units startPoint.X = xcoord startPoint.Y = ycoord startPoint.Z = 0# ' Send a data point to the current command point.X = startPoint.X point.Y = startPoint.Y point.Z = startPoint.Z CadInputQueue.SendDataPoint point, 1 point.X = startPoint.X point.Y = startPoint.Y point.Z = startPoint.Z CadInputQueue.SendDataPoint point, 1 RemoveModalDialogEventsHandler modalHandler CommandState.StartDefaultCommand End Sub
Class Module
Implements IModalDialogEvents Private Sub IModalDialogEvents_OnDialogClosed(ByVal DialogBoxName As String, ByVal DialogResult As MsdDialogBoxResult) End Sub Private Sub IModalDialogEvents_OnDialogOpened(ByVal DialogBoxName As String, DialogResult As MsdDialogBoxResult) If DialogBoxName = "Attach Cell Library" Then CadInputQueue.SendCommand "MDL COMMAND MGDSHOOK,fileList_setDirectoryCmd J:\Microstation\WSMOD\Medesign\V8_Cells\MECELIB\" CadInputQueue.SendCommand "MDL COMMAND MGDSHOOK,fileList_setFileNameCmd parts.cel" ' Remove the following line to let the user close the dialog box. DialogResult = msdDialogBoxResultOK End If ' Attach Cell Library End Sub