乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
楼主: Matersammichman

选取点 - 获取表格单元格

[复制链接]

71

主题

928

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1230
发表于 2007-1-17 12:59:10 | 显示全部楼层
能不能贴一下EntSel函数?这是失踪人员
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-1-18 00:15:53 | 显示全部楼层
它在vba函数Matt中。(他们好像消失了。)

  1. Public Const VK_ESCAPE = &H1B
  2. Public Const VK_LBUTTON = &H1
  3. Public Const VK_SPACE = &H20
  4. Public Const VK_RETURN = &HD
  5. Public Const VK_LEFT = &H25
  6. Public Const VK_MBUTTON = &H4
  7. Public Declare Function GetAsyncKeyState Lib "user32" _
  8.         (ByVal vKey As Long) As Integer
  9. 'Randall single selection
  10. Public Function EntSel(Optional strPrmt As String = "Select an entity: ", Optional vPoint As Variant) As AcadEntity
  11.     Dim objTemp As AcadEntity
  12.     Dim objUtil As AcadUtility
  13.     Dim varPnt As Variant
  14.     Dim varCancel As Variant
  15.     On Error GoTo Err_Control
  16.     Set objUtil = ThisDrawing.Utility
  17.     objUtil.GetEntity objTemp, varPnt, vbCr & strPrmt
  18.     Set EntSel = objTemp
  19.     If Not IsMissing(vPoint) Then
  20.         vPoint = ToWcs(varPnt) ',,,,,,,,Added
  21.     End If
  22. Exit_Here:
  23.     Exit Function
  24. Err_Control:
  25.     Select Case Err.Number
  26.         Case -2147352567
  27.         'Debug.Print Err.Number, Err.Description
  28.         varCancel = ThisDrawing.GetVariable("LASTPROMPT")
  29.         If InStr(1, varCancel, "*Cancel*")  0 Then
  30.             If GetAsyncKeyState(VK_ESCAPE) And 8000 > 0 Then
  31.                 Err.Clear
  32.                 Resume Exit_Here
  33.             ElseIf GetAsyncKeyState(VK_LBUTTON) > 0 Then
  34.                 Err.Clear
  35.                 Resume
  36.             End If
  37.         Else
  38.             If GetAsyncKeyState(VK_SPACE) Then
  39.                 Resume Exit_Here
  40.             End If
  41.             'Missed the pick, send them back!
  42.             Err.Clear
  43.             Resume
  44.         End If
  45.         Case Else
  46.             MsgBox Err.Description
  47.             Resume Exit_Here
  48.     End Select
  49. End Function
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-7 05:11 , Processed in 1.037489 second(s), 54 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表