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
I don't understand why you don't just use the batch processor in microstation and use the function replace cell..
if all your cell libraries are defined in your workspace and the cell names are unique then the replace cell command can be placed into the batch processor script
first for one defined cell , then the others in turn this came be saved and rerun say on several files at a time or the whole folder you need to end with file design so it saves the changes... much easier with the internal tools than coming up with vba and you can run it overnight and it wont crash...
Try it with just 2 or 3 test files first and you'll work it out in no time... I love the batch processor...
Lorys
Started msnt work 1990 - Retired Nov 2022 ( oh boy am I old )
But was long time user V8iss10 (8.11.09.919) dabbler CE update 16 (10.16.00.80)
MicroStation user since 1990 Melbourne Australia.click link to PM me
Rod WingSenior Systems Analyst
Unknown said:Is there a way to have a timer in MicroStation?
Search VBA help for keyword timer.
Regards, Jon Summers LA Solutions
I didn't take a close look at everything in your code, but found a few glaring things that should be cleaned up.
I've made some updates to your getting and stuff routines and posted them below.
Const CELL_LIB_NAME As String = "J:\Microstation\WSMOD\Medesign\V8_Cells\MECELIB\parts.cel"
'These are double values, and should be stored in a single Point3d data type'Dim xcoord, ycoord As IntegerDim ptOrigin As Point3d
'Don't use Variants unless absolutely necessary'Names are stored as Strings'Dim CellName As VariantDim CellName As String
'This counter/index variable is really an Integer value'Dim i As DoubleDim i As Integer
Sub getting()
Dim oCriteria As New ElementScanCriteria Dim ee As ElementEnumerator 'ElementEnumerator is how it is able to search through the entire model for a specific element Dim tc As CellElement
With oCriteria
.ExcludeAllTypes .IncludeType msdElementTypeCellHeader .IncludeType msdElementTypeSharedCell .IncludeOnlyCell CellName
End With
' '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' 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 ptOrigin = tc.Origin Call stuff
Loop
End Sub
Sub stuff()
With CadInputQueue
.SendCommand "rc=" & CELL_LIB_NAME .SendCommand "ac=" & CellName .SendCommand "REPLACE CELLS EXTENDED" .SendDataPoint ptOrigin .SendDataPoint ptOrigin
CommandState.StartDefaultCommand