请问：用getpoint操作时，怎样进行平移缩放及右键结束

myfreemind

在VBA中就完全没有问题，但在VB中还是没有办法实现捕捉，代码如下：

2. Option Explicit
4. Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
6. Private Const VK_ESCAPE = &H1B
7. Dim acadapp As AcadApplication
8. Dim acaddoc As AcadDocument
10. Private Sub Form_Load()
11. Me.Hide
13.     Dim ESC As Long
14.     GetAsyncKeyState VK_ESCAPE
15.     On Error GoTo Err_Control
16.     Dim Pnt1 As Variant
17.     Dim Pnt2 As Variant
18.     Dim line As AcadLine
19.     Dim varCancel As Variant
20.     Set acadapp = GetObject(, "autocad.application")
21.     Set acaddoc = acadapp.ActiveDocument
22.     Pnt1 = acaddoc.Utility.GetPoint(, vbCr & "选择第一点:")
23.    
24.     Do
25.         Pnt2 = acaddoc.Utility.GetPoint(Pnt1, vbCr & "选择下一点:")
26.         Set line = acaddoc.ModelSpace.AddLine(Pnt1, Pnt2)
27.         Pnt1 = Pnt2
28.     Loop
30. Exit_Here:
31.   Exit Sub
32. Err_Control:
33.     varCancel = acaddoc.GetVariable("LASTPROMPT")
34.     ESC = GetAsyncKeyState(VK_ESCAPE)
35.     Select Case Err.Number
36.         '按了取消键或其它透明命令
37.         Case -2147352567
38.             '如果命令行提示中没有“取消”这样的文字出现
39.             '一般来说在2002中按了回车或空格都不会出现“取消”
40.             '则退出
41.             If InStr(1, varCancel, "*Cancel*") <> 0 And _
42.                InStr(1, varCancel, "*取消*") <> 0 Then
43.                 Err.Clear
44.                 Resume Exit_Here
45.             '如果按了ESC键，则退出
46.             ElseIf ESC <> 0 Then
47.                 Err.Clear
48.                 Resume Exit_Here
49.             '其它情况下，则恢复。如选择了透明命令，则会出现“取消”
50.             '字样，但不是按了“取消”键。
51.             Else
52.                 Err.Clear
53.                 Resume
54.             End If
55.         '右键单击或回车或空格。
56.         '在这里，-2147467259用于AutoCAD 2000 及2002，
57.         '而-2145320928为2004专用
58.         Case -2147467259, -2145320928
59.             Err.Clear
60.             Resume Exit_Here
61.         '其它情况，一律退出
62.         Case Else
63.             Err.Clear
64.             Resume Exit_Here
65.     End Select
66. End Sub

Option Explicit Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer Private Const VK_ESCAPE = &H1B Dim acadapp As AcadApplication Dim acaddoc As AcadDocument Private Sub Form_Load() Me.Hide     Dim ESC As Long     GetAsyncKeyState VK_ESCAPE     On Error GoTo Err_Control     Dim Pnt1 As Variant     Dim Pnt2 As Variant     Dim line As AcadLine     Dim varCancel As Variant     Set acadapp = GetObject(, "autocad.application")     Set acaddoc = acadapp.ActiveDocument     Pnt1 = acaddoc.Utility.GetPoint(, vbCr & "选择第一点:")         Do         Pnt2 = acaddoc.Utility.GetPoint(Pnt1, vbCr & "选择下一点:")         Set line = acaddoc.ModelSpace.AddLine(Pnt1, Pnt2)         Pnt1 = Pnt2     Loop Exit_Here:   Exit Sub Err_Control:     varCancel = acaddoc.GetVariable("LASTPROMPT")     ESC = GetAsyncKeyState(VK_ESCAPE)     Select Case Err.Number         '按了取消键或其它透明命令         Case -2147352567             '如果命令行提示中没有“取消”这样的文字出现             '一般来说在2002中按了回车或空格都不会出现“取消”             '则退出             If InStr(1, varCancel, "*Cancel*") <> 0 And _                InStr(1, varCancel, "*取消*") <> 0 Then                 Err.Clear                 Resume Exit_Here             '如果按了ESC键，则退出             ElseIf ESC <> 0 Then                 Err.Clear                 Resume Exit_Here             '其它情况下，则恢复。如选择了透明命令，则会出现“取消”             '字样，但不是按了“取消”键。             Else                 Err.Clear                 Resume             End If         '右键单击或回车或空格。         '在这里，-2147467259用于AutoCAD 2000 及2002，         '而-2145320928为2004专用         Case -2147467259, -2145320928             Err.Clear             Resume Exit_Here         '其它情况，一律退出         Case Else             Err.Clear             Resume Exit_Here     End Select End Sub

mikewolf2k

太好了,谢谢

无痕

getpoint可以透明使用‘pan，’zoom命令啊。
(while (setq pt (getpoint "\n选点:"))
  (setq ptlst (cons pt ptlst))
)

gongxiaosan

有一个问题不明白，如何做到在vba中使用getpoint时能够象在界面中直接操作一样，使用临时追踪点或其他透明命令

洋葱老爹

太麻烦了,应该还有简单的方法.

shenhui

最好的解决办法是用ObjectArx来编写

laoliu09

好！谢谢！

clh2321890

全是高手啊，

sieben

1,我的右键单击或回车或空格的错误代码是:-2145320928 2,按ESC键ESCKey的值是False 3,点击Zoom按钮没有產生错误

czlj2008

佩服，斑竹真是个高手，佩服,了不起,不简单