|
|
下面是我用关键字的有点问题，请大家帮我看看怎么回事。我想在注记的时候通过鼠标右键来结束程序，该怎么弄呢？
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(, "请点取宗地号注记位置:: ")
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 |
|
置顶卡
