MicroStation VBA 可视化界面

第十章 可视界面

Private Sub UserForm_Initialize()

Dim ViewCen As Point3d

Dim MyView As View

For Each MyView In ActiveDesignFile.Views

cmbViews.AddItem MyView.Index

Next

cmbViews.ListIndex = 

ViewCen = ActiveDesignFile.Views().Center

ScrX.Value = ViewCen.X

scrY.Value = ViewCen.Y

End Sub

Sub SetZoom(ZoomValue As Long, OldZoomValue As Long)

ActiveDesignFile.Views(cmbViews.Text).Zoom  + (ZoomValue - OldZoomValue) / 

ActiveDesignFile.Views(cmbViews.Text).Redraw

End Sub

Sub SetPan(XPan As Long, YPan As Long)

Dim ViewOrigin As Point3d

ViewOrigin.X = XPan

ViewOrigin.Y = YPan

ViewOrigin.Z = 

ActiveDesignFile.Views(cmbViews.Text).Center = ViewOrigin

ActiveDesignFile.Views(cmbViews.Text).Redraw

End Sub

Private Sub scrZoom_Change()

SetZoom ScrZoom.Value, ScrZoom.Tag

ScrZoom.Tag = ScrZoom.Value

End Sub

Private Sub scrZoom_Scroll()

SetZoom ScrZoom.Value, ScrZoom.Tag

ScrZoom.Tag = ScrZoom.Value

End Sub

Private Sub scrX_Change()

SetPan ScrX.Value, scrY.Value

End Sub

Private Sub scrX_Scroll()

SetPan ScrX.Value, scrY.Value

End Sub

Private Sub scrY_Change()

SetPan ScrX.Value, scrY.Value

End Sub

Private Sub scrY_Scroll()

SetPan ScrX.Value, scrY.Value

End Sub

本章回顾：

1.所有空间都有属性、方法和事件

2.访问空间的属性和方法的格式是：空间名，一个点号，属性和方法，需要时提供参数

3.程序运行时，用户与界面间的交互触发事件

4.用Show方法显示用户窗体

5.在窗口显示前，用Initialize事件设置值和增加控件

第十一章 MicroStation对象模型——对象

提供了库的对象模型，VBA中的对象浏览器最有帮助，VBA还包括其他有助于开发的工具，例如添加监视和自动列表功能

第十二章 MicroStation对象模型——枚举 Enumeration

枚举的优点：在分析代码时能更容易地看到所需参数的结果。

枚举成员名称经常以枚举名称或枚举名称的缩略版本开头。例如msdDesignFileFormatDWG 就是枚举名称“MsdDesignFileFormat”开头的。

MicroStation中所有的枚举都是以指定的三个字符“Msd”开头，所有的成员都以“msd”开头

第十四章 MicroStation对象模型——事件

对象具有方法、属性和事件。

P259

P155

第十五章 向文档中添加内容

使用冒号(:)把两行代码放到一行。将同一顶点的赋值放在一行上也增加了代码的易读性

Sub CreateLines()

Dim LinePoints1( To ) As Point3d

Dim LinePoints2( To ) As Point3d

Dim myLine1 As LineElement

Dim myLine2 As LineElement

Dim I As Long

For I =  To  Step 

LinePoints1(I).X = I ^  - I ^ : LinePoints1(I).Y = I + I ^ 

LinePoints2(I).X = I ^  - I ^ : LinePoints2(I).Y = -(I + I ^ )

Next I

Set myLine1 = CreateLineElement1(Nothing, LinePoints1)

Set myLine2 = CreateLineElement1(Nothing, LinePoints2)

ActiveModelReference.AddElement myLine1

ActiveModelReference.AddElement myLine2

End Sub

Sub CLines(ParamArray PointElems() As Variant)

If (UBound(PointElems) + ) Mod  <>  Then

MsgBox "Invaid number of point elements", vbCritical

Exit Sub

End If

If (UBound(PointElems) + ) <  Then

MsgBox "A minimum of 2 X,Y,Z points must be provided.", vbCritical

Exit Sub

End If

Dim LinePoints() As Point3d

ReDim LinePoints( To (UBound(PointElems) + ) \ ) As Point3d

Dim I As Long

Dim PointCounter As Long

Dim MyLine As LineElement

For I = LBound(PointElems) To UBound(PointElems) Step 

LinePoints(PointCounter).X = PointElems(I)

LinePoints(PointCounter).Y = PointElems(I + )

LinePoints(PointCounter).Z = PointElems(I + )

PointCounter = PointCounter + 

Next I

Set MyLine = CreateLineElement1(Nothing, LinePoints)

ActiveModelReference.AddElement MyLine

End Sub

Sub TestCLines()

CLines , , , , , , , , , , , , , , 

CLines , , , , , 

CLines , , , , , 

CLines , , , , 

CLines , , 

End Sub

建立形

Function CreatePolygon(CenterPoint As Point3d, NumOfSides As Long, Radius As Double) As ShapeElement

Dim myShape As ShapeElement

Dim ShapePoints() As Point3d

ReDim ShapePoints( To NumOfSides - ) As Point3d

Dim PointIndex As Long

Dim IncAngle As Double

IncAngle =  / NumOfSides

For PointIndex = LBound(ShapePoints) To UBound(ShapePoints)

ShapePoints(PointIndex) = Point3dAddAngleDistance(CenterPoint, Radians(IncAngle * PointIndex), Radius, )

Next

Set CreatePolygon = CreateShapeElement1(Nothing, ShapePoints)

End Function

Sub TestCreatePolygon()

Dim CPoint As Point3d

Dim myShape As ShapeElement

Dim I As Long

Dim Length As Double

Length = 

For I =  To  Step 

Set myShape = CreatePolygon(CPoint, I, Length)

Length = Length + 

ActiveModelReference.AddElement myShape

Next I

End Sub

Dim CPoint As Point3d

Dim myEllipse As EllipseElement

Dim rotMatrix As Matrix3d

Dim inputQueue As CadInputQueue

Dim intputMessage As CadInputMessage

Set inputQueue = CadInputQueue

Set inputMessage = inputQueue.GetInput(msdCadInputTypeDataPoint, msdCadInputTypeAny)

Do

Select Case inputMessage.InputTyoe

Case msdCadInputTypeDatePoint

CPoint = inputMessage.Point

Set myEllipse = CreateEllipseElement2(Nothing, CPoint, 0.5, 0.5, rotMatrix)

ActiveModelReference.AddElement myEllipse

Exit Do

Case msdCadInputTypeReset

Exit Do

End Select

Loop