When I use the record macro feature in the vba project manager, say...to record placing a block, when i play the same macro back the scale is wrong (unless the ACS plane lock is on) and the ellipses are rotated 90 degrees in the x axis and 53 degrees in the y axis so they appear like a diagonal lines in the top view. By the way I'm new to microstation so I may need some help on terminology as well as coding.
Here is the some code I'm having a problem with the ellipses in
Sub MacroDuct() On Error GoTo errhnd Dim selPts() As Point3d Dim pt3TextPt As Point3d Dim pt3dUL As Point3d Dim pt3dUR As Point3d Dim pt3dBL As Point3d Dim pt3dBR As Point3d Dim myCenPtT As Point3d Dim myCenPtB As Point3d Dim myCen As Point3d Dim rotMatrix As Matrix3d Dim myLine As LineElement Dim myCir As EllipseElement selPts = PointsByLine CadInputQueue.SendReset CommandState.StartDefaultCommand 'check for horizontal orientation If selPts(0).X <> selPts(1).X Then 'set horizontal pts pt3dUL.X = selPts(0).X pt3dUL.Y = selPts(0).Y + 1.125 pt3dUL.Z = selPts(0).Z pt3dUR.X = selPts(1).X pt3dUR.Y = selPts(1).Y + 1.125 pt3dUR.Z = selPts(1).Z pt3dBL.X = selPts(0).X pt3dBL.Y = selPts(0).Y - 1.125 pt3dBL.Z = selPts(0).Z pt3dBR.X = selPts(1).X pt3dBR.Y = selPts(1).Y - 1.125 pt3dBR.Z = selPts(1).Z myCenPtT.X = selPts(0).X + 2 myCenPtT.Y = selPts(0).Y + 0.5 myCenPtT.Z = selPts(0).Z myCenPtB.X = selPts(0).X + 2 myCenPtB.Y = selPts(0).Y - 0.5 myCenPtB.Z = selPts(0).Z Else 'set vertical pts pt3dUL.X = selPts(0).X - 1.125 pt3dUL.Y = selPts(0).Y pt3dUL.Z = selPts(0).Z pt3dUR.X = selPts(0).X + 1.125 pt3dUR.Y = selPts(0).Y pt3dUR.Z = selPts(0).Z pt3dBL.X = selPts(1).X - 1.125 pt3dBL.Y = selPts(1).Y pt3dBL.Z = selPts(1).Z pt3dBR.X = selPts(1).X + 1.125 pt3dBR.Y = selPts(1).Y pt3dBR.Z = selPts(1).Z End If Set myLine = CreateLineElement2(Nothing, pt3dUL, pt3dUR) ActiveModelReference.AddElement myLine Set myLine = CreateLineElement2(Nothing, pt3dBL, pt3dBR) ActiveModelReference.AddElement myLine Set myLine = CreateLineElement2(Nothing, pt3dUL, pt3dBL) ActiveModelReference.AddElement myLine Set myLine = CreateLineElement2(Nothing, pt3dUR, pt3dBR) ActiveModelReference.AddElement myLine Set myCir = CreateEllipseElement2(Nothing, myCen, 0.068, 0.068, rotMatrix) ActiveModelReference.AddElement myCir Set myCir = CreateEllipseElement2(Nothing, myCenPtB, 0.068, 0.068, rotMatrix) ActiveModelReference.AddElement myCir Exit Suberrhnd: CadInputQueue.SendReset CommandState.StartDefaultCommand Select Case Err.Number Case -12345 'Start Point not selected MsgBox "Start Point not selected.", vbCritical Case -12346 'End Point not selected MsgBox "End Point not selected.", vbCritical End SelectEnd SubFunction PointsByLine() As Point3d() Dim myCIQ As CadInputQueue Dim myCIM As CadInputMessage Dim pt3Start As Point3d Dim pt3End As Point3d Dim selPts(0 To 1) As Point3d Set myCIQ = CadInputQueue Set myCIM = myCIQ.GetInput(msdCadInputTypeDataPoint, _ msdCadInputTypeReset) Select Case myCIM.InputType Case msdCadInputTypeReset Err.Raise -12345 Exit Function Case msdCadInputTypeDataPoint pt3Start = myCIM.point End Select CadInputQueue.SendCommand "LOCK AXIS ON" CadInputQueue.SendCommand "PLACE LINE" CadInputQueue.SendDataPoint pt3Start Set myCIM = myCIQ.GetInput(msdCadInputTypeDataPoint, _ msdCadInputTypeReset) Select Case myCIM.InputType Case msdCadInputTypeReset Err.Raise -12346 Exit Function Case msdCadInputTypeDataPoint pt3End = myCIM.point End Select selPts(0) = pt3Start selPts(1) = pt3End PointsByLine = selPtsEnd Function
Sub MacroDuct()
On Error GoTo errhnd Dim selPts() As Point3d Dim pt3TextPt As Point3d Dim pt3dUL As Point3d
Dim pt3dUR As Point3d
Dim pt3dBL As Point3d
Dim pt3dBR As Point3d
Dim myCenPtT As Point3d
Dim myCenPtB As Point3d
Dim myCen As Point3d
Dim rotMatrix As Matrix3d
Dim myLine As LineElement
Dim myCir As EllipseElement
selPts = PointsByLine
CadInputQueue.SendReset
CommandState.StartDefaultCommand
'check for horizontal orientation
If selPts(0).X <> selPts(1).X Then
'set horizontal pts
pt3dUL.X = selPts(0).X
pt3dUL.Y = selPts(0).Y + 1.125
pt3dUL.Z = selPts(0).Z
pt3dUR.X = selPts(1).X
pt3dUR.Y = selPts(1).Y + 1.125
pt3dUR.Z = selPts(1).Z
pt3dBL.X = selPts(0).X
pt3dBL.Y = selPts(0).Y - 1.125
pt3dBL.Z = selPts(0).Z
pt3dBR.X = selPts(1).X
pt3dBR.Y = selPts(1).Y - 1.125
pt3dBR.Z = selPts(1).Z
myCenPtT.X = selPts(0).X + 2
myCenPtT.Y = selPts(0).Y + 0.5
myCenPtT.Z = selPts(0).Z
myCenPtB.X = selPts(0).X + 2
myCenPtB.Y = selPts(0).Y - 0.5
myCenPtB.Z = selPts(0).Z
Else
'set vertical pts
pt3dUL.X = selPts(0).X - 1.125
pt3dUL.Y = selPts(0).Y
pt3dUR.X = selPts(0).X + 1.125
pt3dUR.Y = selPts(0).Y
pt3dUR.Z = selPts(0).Z
pt3dBL.X = selPts(1).X - 1.125
pt3dBL.Y = selPts(1).Y
pt3dBL.Z = selPts(1).Z
pt3dBR.X = selPts(1).X + 1.125
pt3dBR.Y = selPts(1).Y
End If
Set myLine = CreateLineElement2(Nothing, pt3dUL, pt3dUR)
ActiveModelReference.AddElement myLine
Set myLine = CreateLineElement2(Nothing, pt3dBL, pt3dBR)
Set myLine = CreateLineElement2(Nothing, pt3dUL, pt3dBL)
Set myLine = CreateLineElement2(Nothing, pt3dUR, pt3dBR)
Set myCir = CreateEllipseElement2(Nothing, myCen, 0.068, 0.068, rotMatrix)
ActiveModelReference.AddElement myCir
Set myCir = CreateEllipseElement2(Nothing, myCenPtB, 0.068, 0.068, rotMatrix)
Exit Sub
errhnd:
Select Case Err.Number
Case -12345
'Start Point not selected
MsgBox "Start Point not selected.", vbCritical
Case -12346
'End Point not selected
MsgBox "End Point not selected.", vbCritical
End Select
End Sub
Function PointsByLine() As Point3d()
Dim myCIQ As CadInputQueue
Dim myCIM As CadInputMessage
Dim pt3Start As Point3d
Dim pt3End As Point3d
Dim selPts(0 To 1) As Point3d
Set myCIQ = CadInputQueue
Set myCIM = myCIQ.GetInput(msdCadInputTypeDataPoint, _
msdCadInputTypeReset)
Select Case myCIM.InputType
Case msdCadInputTypeReset
Err.Raise -12345
Exit Function
Case msdCadInputTypeDataPoint
pt3Start = myCIM.point
CadInputQueue.SendCommand "LOCK AXIS ON"
CadInputQueue.SendCommand "PLACE LINE"
CadInputQueue.SendDataPoint pt3Start
Err.Raise -12346
pt3End = myCIM.point
selPts(0) = pt3Start
selPts(1) = pt3End
PointsByLine = selPts
End Function
Dim rotMatrix As Matrix3d ... Set myCir = CreateEllipseElement2(Nothing, myCen, 0.068, 0.068, rotMatrix)
You use a rotation matrix without initialising that variable.
When you declare a variable and don't assign it a value, VBA attempts to set a default value. For Example, an Integer defaults to a value of zero. However, VBA knows nothing about User Defined Types (UDTs) and doesn't know how to initialise them, so it sets the contents to zero in the hope that that might work.
Unfortunately a default value of zero is not always a reasonable value for all UDTs. A rotation matrix with all members zero is invalid. To avoid this, initialise your variable like this …
rotMatrix = Matrix3dIdentity
Regards, Jon Summers LA Solutions
Jon
Thanks for the reply. I tried initializing the rotmatrix variable, but I'm still having the same problem with my ellipses. The problem doesn't occur with text elements I place using the rotmatrix variable....only ellipse elements. Any thoughts?
It works! Thanks. I temporarily changed my rotmatrix variable and forgot to change it back.