[求助]怎样在cad中获取鼠标右击事件？

laoxie_198

下面是我用关键字的有点问题，请大家帮我看看怎么回事。我想在注记的时候通过鼠标右键来结束程序，该怎么弄呢？

ption Explicit

Private Const VK_ESCAPE = &H1B      ' 代表Esc键
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Sub ll()
Dim cn As New ADODB.Connection
Dim gdp As New ADODB.Recordset
Dim sqllj As String, jfh As String
Dim maxzdh As Integer, zdh As Integer '最大宗地号、宗地号
Dim zjpoint(0 To 2) As Double  '注记点坐标
Dim textobj As AcadText
Dim tc As AcadLayer
Dim msg As String
msg$ = "请输入街坊号:"
i: jfh = Trim(InputBox(msg$, "数据输入", " 320506432002"))
If jfh = "" Then
  MsgBox "街坊号输入有误，请重新输入"
  GoTo i
 End If
sqllj = "provider=sqloledb.1;password= ;persist security info=true;user id=sa;initial catalog=wzdb ;data source=hbxx"
cn.Open sqllj
gdp.Open "select zd=max(description) from gdp where pid in (select lpid from gdlp where isvirtual =0) and eoid in (select eoid from gdeo where description='" & jfh & "')", cn, adOpenDynamic, adLockBatchOptimistic
If Not gdp.EOF Then
 maxzdh = gdp.Fields("zd")
End If
gdp.Close
cn.Close
Dim returnPnt As Variant
Dim ptPrevious As Variant
Dim strKeyWords As String
    strKeyWords = "W E O"
    Dim objPline As AcadLWPolyline
NEXTPOINT:
    ' 设置关键字
    ThisDrawing.Utility.InitializeUserInput 128, strKeyWords
    BeginShortcutMenuDefault
    returnPnt = ThisDrawing.Utility.GetPoint(, "请点取宗地号注记位置:<结束(e)>: ")
    If Err Then                 ' 在错误处理中判断用户输入的关键字
        If StrComp(Err.Description, "用户输入的是关键字", 1) = 0 Then
            Dim strInput As String
            strInput = ThisDrawing.Utility.GetInput
            Err.Clear

            ' 根据输入的关键字进行相应的处理
            If StrComp(strInput, "e", vbTextCompare) = 0 Then
                Exit Sub
                'GoTo NEXTPOINT
            Else
            GoTo NEXTPOINT
            End If
        'ElseIf StrComp(Err.Description, "自动化 (Automation) 错误", vbTextCompare) = 0 Then
'        ElseIf Err.Number = -2147352567 Then
'            Err.Clear
'            Exit Sub
        Else
            Err.Clear
            ' 判断用户是否按下了Esc键
            If CheckKey(VK_ESCAPE) = True Then
                Exit Sub
         End If
        End If
        Else
        zjpoint(0) = returnPnt(0)
        zjpoint(1) = returnPnt(1)
        zjpoint(2) = returnPnt(2)
        zdh = maxzdh + 1
        Set textobj = ThisDrawing.ModelSpace.AddText(zdh, zjpoint, 2)
        textobj.Update
        maxzdh = maxzdh + 1
         GoTo NEXTPOINT
    End If
   
    ' Return a point using a prompt
'returnPnt = ThisDrawing.Utility.GetPoint(, "请点取宗地号注记位置: ")

      'Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
      ThisDrawing.Application.ZoomAll
     

End Sub

Private Function CheckKey(lngKey As Long) As Boolean
    If GetAsyncKeyState(lngKey) Then
        CheckKey = True
    Else
        CheckKey = False
    End If
End Function