【MVBA MS V8I】请问如何用右键实现模型的导入或者添加？

Question

本人用MVBA编写了一个多引线的标注程序，但是有一个地方一直没有想通和完成。 
 问题描述 
 1.左键承担的选取各个功能不同的点。 
 2.右键承担点击后完成模型导入的功能。 
 Private Sub IPrimitiveCommandEvents_Reset()
 ActiveModelReference.AddElement eleCell
End Sub 
 但是实际执行的时候，无法实现右键reset完成模型的导入，以至于模型一直在动态展示。 
 3.问题即便描述了，好像还是很困惑。后附程序，各位老师运行后，便可以知道我的问题。

Wulix · Accepted Answer

你的 eleCell是个在 Dynamics方法中定义 局部变量，并不是全局的类变量，在Dynamics 中的eleCell变量在方法执行完成后就被清理掉了。你在 Reset里面设置的eleCell实际上是并未定义的。你需要在Reset里重新生成一遍。你在代码最前面加上 Option Explicit ，你的代码是会报错的。 
 此外，右键按照MS的软件操作习惯，一般是中断的意思，你可以在进入 Dynamics前设置一个全局的标记变量，这样在Dynamics后你鼠标左键点击了一下，进入DataPoint方法后执行现在 Reset中的代码。 
 Reset方法里写一个 方法， 选错点了，能重新选点。 
 代码改了一下，已经能用。 
 Implements IPrimitiveCommandEvents
 Private i As Integer, p As Long, n_atPts As Integer
 Private m_atPoints() As Point3d, StartPt As Point3d, SecPt As Point3d
 Private Lipoints() As Point3d 'Lipoints是对应每一个标注点上面的点

Private Sub IPrimitiveCommandEvents_Cleanup()

End Sub

Private Sub IPrimitiveCommandEvents_DataPoint(Point As Point3d, ByVal View As View)
 If n_atPts = 0 Then
 StartPt = Point
 ShowPrompt "指定起始点位置"
 n_atPts = 1
 ElseIf n_atPts = 1 Then
 SecPt = Point
 ShowPrompt "指定起始标注位置"
 CommandState.StartDynamics
 n_atPts = 2
 ElseIf n_atPts = 2 Then
 m_atPoints(0) = Point
 ReDim Preserve m_atPoints(UBound(m_atPoints) + 1)
 ShowPrompt "指定后续标注位置"
 n_atPts = 3
 Else
 m_atPoints(UBound(m_atPoints)) = Point
 ReDim Preserve m_atPoints(UBound(m_atPoints) + 1)
 Call IPrimitiveCommandEvents_Dynamics(Point, View, msdDrawingModeNormal)
 End If
End Sub

Private Sub IPrimitiveCommandEvents_Dynamics(Point As Point3d, ByVal View As View, ByVal DrawMode As MsdDrawingMode)
 
 Dim eleCell As CellElement
 
 Set eleCell = MyEleCell(Point)
 eleCell.Redraw DrawMode
 'If DrawMode = msdDrawingModeNormal Then
 'ActiveModelReference.AddElement eleCell
 'End If
End Sub

Private Sub IPrimitiveCommandEvents_Keyin(ByVal Keyin As String)

End Sub

Private Sub IPrimitiveCommandEvents_Reset()
 
 Dim eleCell As CellElement
 
 Set eleCell = MyEleCell(CommandState.LastDataPoint)
 ActiveModelReference.AddElement eleCell
 eleCell.Redraw
 eleCell.Rewrite
 CommandState.StartDefaultCommand
End Sub

Private Sub IPrimitiveCommandEvents_Start()
 ReDim m_atPoints(0)
End Sub
Private Function MyEleCell(Point As Point3d) As CellElement
Dim txtStr(0 To 1) As String
 Dim txtPts(0 To 1) As Point3d
 Dim LinePts As Point3d
 Dim txtLen As Double, txtLineSpacing As Double, JD As Double, txtHeight As Double, n As Double, m As Double, NumP As Long 'NumP是后续标注点个数
 Dim ele() As Element
 Dim eleCell As CellElement
 
 m_atPoints(UBound(m_atPoints)) = Point '用户指定的最后一个点
 NumP = UBound(m_atPoints) '点的个数减一
 ReDim Preserve Lipoints(NumP + 2)
 ReDim Preserve ele(NumP + 5)
 
 txtStr(0) = frmDuoYX.TextBoxXS.Value '上标文字
 txtStr(1) = frmDuoYX.TextBoxXX.Value '下标文字
 
 n = 0 '给出标注线长度
 For i = 1 To Len(txtStr(0))
 m = Asc(Mid(txtStr(0), i, 1))
 If m > 47 And m < 122 Then
 n = n + 1
 End If
 Next i
 
 JD = Val(frmDuoYX.TextBoxJD.Value) * Pi / 180 '倾斜角度
 
 txtLen = Len(txtStr(0)) - 0.43 * n
 MyTextStyle = frmDuoYX.ComboBoxString.Value
 txtLineSpacing = txtLen * ActiveDesignFile.TextStyles(MyTextStyle).Height
 txtHeight = ActiveDesignFile.TextStyles(MyTextStyle).Height * IIf(n > 0, 1, 1.1) * 0.45

 Lipoints(0) = SecPt
 For p = 1 To NumP
 Lipoints(p).X = m_atPoints(p).X + SecPt.X - StartPt.X
 Lipoints(p).Y = SecPt.Y
 Set ele(p + 3) = CreateLineElement2(Nothing, m_atPoints(p), Lipoints(p))
 Next p
 LinePts.X = Lipoints(NumP).X + IIf(m_atPoints(0).X > m_atPoints(1).X, -Cos(JD) * txtLineSpacing, Cos(JD) * txtLineSpacing)
 LinePts.Y = Lipoints(NumP).Y + IIf(m_atPoints(0).X > m_atPoints(1).X, -Sin(JD) * txtLineSpacing, Sin(JD) * txtLineSpacing)

 txtPts(0).X = Lipoints(NumP).X - txtHeight * Sin(JD) * txtHeight
 txtPts(0).Y = Lipoints(NumP).Y + txtHeight * Cos(JD) * txtHeight

 txtPts(1).X = Lipoints(NumP).X + txtHeight * Sin(JD) * txtHeight
 txtPts(1).Y = Lipoints(NumP).Y - txtHeight * Cos(JD) * txtHeight
 
 Set ele(0) = CreateLineElement2(Nothing, StartPt, SecPt)
 Set ele(1) = CreateLineElement2(Nothing, SecPt, LinePts)

 Set ele(2) = CreateTextElement1(Nothing, txtStr(0), txtPts(0), Matrix3dIdentity)
 Set ele(2).AsTextElement.TextStyle = ActiveDesignFile.TextStyles(MyTextStyle)
 ele(2).AsTextElement.TextStyle.Justification = IIf(m_atPoints(0).X > m_atPoints(1).X, msdTextJustificationRightCenter, msdTextJustificationLeftCenter)
 ele(2).AsTextElement.RotateAboutZ txtPts(0), JD

 Set ele(3) = CreateTextElement1(Nothing, txtStr(1), txtPts(1), Matrix3dIdentity)
 Set ele(3).AsTextElement.TextStyle = ActiveDesignFile.TextStyles(MyTextStyle)
 ele(3).AsTextElement.TextStyle.Justification = IIf(m_atPoints(0).X > m_atPoints(1).X, msdTextJustificationRightCenter, msdTextJustificationLeftCenter)
 ele(3).AsTextElement.RotateAboutZ txtPts(1), JD
 
 Set MyEleCell = CreateCellElement1(vbNullString, ele, m_atPoints(NumP), False)
End Function

【MVBA MS V8I】请问如何用右键实现模型的导入或者添加？

Top Replies