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