[V8i VBA] Moving cell origin in a model

Hi,

I have a cell library (which is attached). Cell origins are given wrong (far from cells) by user in cell library. I am trying to move cell origins as bottom left coordinates of cabinets using below VBA code. VBA code works properly without any error but at the end cell origins are not set properly. After VBA code ended, MicroStation waits for a click every time. Can you tell me what is wrong?

' Fix cell origins to the bottom back of each cabinet

Sub CellOriginFix()

' How to move the origin of a cell in the cell library.
' 1. Open the Cell Library
' 2. Go to File > Models and choose the Cell/Model that you want to modify.
' 3. Key-in: choose all;move extended;/d;xy=0,0,0
' 4. Select the point where you want the origin of the cell to be.

'  This method is taken from http://communities.bentley.com/products/microstation/w/microstation__wiki/13946.move-the-origin-of-a-cell

Dim theModel As ModelReference
Dim theRange As Range3d
Dim thePoint As Point3d

For Each theModel In ActiveDesignFile.Models

theModel.Activate ' Activate model

theRange = theModel.Range(False) ' Get model range

' Define cell origin point according to model range
thePoint.X = theRange.Low.X
thePoint.Y = theRange.High.Y
thePoint.Z = theRange.Low.Z

'MessageCenter.AddMessage thePoint.X

' Set cell origin
CadInputQueue.SendKeyin "choose all;move extended;/d;xy=0,0,0"

' Click origin
CadInputQueue.SendDataPoint thePoint, 1

' Send a reset to the current command
CadInputQueue.SendReset

CadInputQueue.SendCommand "FIT VIEW EXTENDED 1"
CadInputQueue.SendCommand "FIT VIEW EXTENDED 2"
CadInputQueue.SendCommand "FIT VIEW EXTENDED 3"
CadInputQueue.SendCommand "FIT VIEW EXTENDED 4"

Next

CommandState.StartDefaultCommand

End Sub

test.cel

Parents Reply Children