明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
楼主: zgyxn

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

    [复制链接]
发表于 2003-12-22 22:20 | 显示全部楼层
在VBA中就完全没有问题,但在VB中还是没有办法实现捕捉,代码如下:
  1. Option Explicit
  2. Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
  3. Private Const VK_ESCAPE = &H1B
  4. Dim acadapp As AcadApplication
  5. Dim acaddoc As AcadDocument
  6. Private Sub Form_Load()
  7. Me.Hide
  8.     Dim ESC As Long
  9.     GetAsyncKeyState VK_ESCAPE
  10.     On Error GoTo Err_Control
  11.     Dim Pnt1 As Variant
  12.     Dim Pnt2 As Variant
  13.     Dim line As AcadLine
  14.     Dim varCancel As Variant
  15.     Set acadapp = GetObject(, "autocad.application")
  16.     Set acaddoc = acadapp.ActiveDocument
  17.     Pnt1 = acaddoc.Utility.GetPoint(, vbCr & "选择第一点:")
  18.    
  19.     Do
  20.         Pnt2 = acaddoc.Utility.GetPoint(Pnt1, vbCr & "选择下一点:")
  21.         Set line = acaddoc.ModelSpace.AddLine(Pnt1, Pnt2)
  22.         Pnt1 = Pnt2
  23.     Loop
  24. Exit_Here:
  25.   Exit Sub
  26. Err_Control:
  27.     varCancel = acaddoc.GetVariable("LASTPROMPT")
  28.     ESC = GetAsyncKeyState(VK_ESCAPE)
  29.     Select Case Err.Number
  30.         '按了取消键或其它透明命令
  31.         Case -2147352567
  32.             '如果命令行提示中没有“取消”这样的文字出现
  33.             '一般来说在2002中按了回车或空格都不会出现“取消”
  34.             '则退出
  35.             If InStr(1, varCancel, "*Cancel*") <> 0 And _
  36.                InStr(1, varCancel, "*取消*") <> 0 Then
  37.                 Err.Clear
  38.                 Resume Exit_Here
  39.             '如果按了ESC键,则退出
  40.             ElseIf ESC <> 0 Then
  41.                 Err.Clear
  42.                 Resume Exit_Here
  43.             '其它情况下,则恢复。如选择了透明命令,则会出现“取消”
  44.             '字样,但不是按了“取消”键。
  45.             Else
  46.                 Err.Clear
  47.                 Resume
  48.             End If
  49.         '右键单击或回车或空格。
  50.         '在这里,-2147467259用于AutoCAD 2000 及2002,
  51.         '而-2145320928为2004专用
  52.         Case -2147467259, -2145320928
  53.             Err.Clear
  54.             Resume Exit_Here
  55.         '其它情况,一律退出
  56.         Case Else
  57.             Err.Clear
  58.             Resume Exit_Here
  59.     End Select
  60. End Sub
发表于 2004-1-1 21:56 | 显示全部楼层
太好了,谢谢
发表于 2004-1-10 21:41 | 显示全部楼层
getpoint可以透明使用‘pan,’zoom命令啊。
(while (setq pt (getpoint "\n选点:"))
  (setq ptlst (cons pt ptlst))
)
发表于 2004-1-11 19:32 | 显示全部楼层
有一个问题不明白,如何做到在vba中使用getpoint时能够象在界面中直接操作一样,使用临时追踪点或其他透明命令
发表于 2004-6-29 14:29 | 显示全部楼层
太麻烦了,应该还有简单的方法.
发表于 2004-7-10 22:55 | 显示全部楼层
最好的解决办法是用ObjectArx来编写
发表于 2004-10-30 21:07 | 显示全部楼层
好!谢谢!
发表于 2004-11-23 08:10 | 显示全部楼层
全是高手啊,
发表于 2004-12-21 12:49 | 显示全部楼层
1,我的右键单击或回车或空格的错误代码是:-2145320928 2,按ESC键ESCKey的值是False 3,点击Zoom按钮没有產生错误
发表于 2005-8-13 09:36 | 显示全部楼层
佩服,斑竹真是个高手,佩服,了不起,不简单
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-28 21:50 , Processed in 0.215159 second(s), 17 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表