乐筑天下

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

获取Xrecord数据(第2课)

[复制链接]

28

主题

249

帖子

7

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
361
发表于 2006-7-18 13:24:20 | 显示全部楼层 |阅读模式
这是我的代码[代码第一个似乎有效 我尝试了两个图形,一个有信息,没有错误消息提示,一个没有信息,并得到了错误消息 我的问题似乎是第二个代码 本人'我想看看是否可以在不指定大小的情况下获取xrecord数据,然后将其打印到消息框中(目前命令行也可以)
提前感谢您的帮助
这是用于添加xrecord和dictionary(以防万一)的lisp代码
  1. (defun MySetXRec (Obj CodeList DataList / )
  2. ; Sets XRecordData. Dxf numbers between 1-369, except 5, 100, 105.
  3. ; See help for types and numbers to use.
  4. (vla-SetXRecordData Obj
  5. (vlax-make-variant
  6.   (vlax-safearray-fill
  7.    (vlax-make-safearray
  8.     vlax-vbInteger
  9.     (cons 0 (1- (length CodeList)))
  10.    )
  11.    CodeList
  12.   )
  13. )
  14. (vlax-make-variant
  15.   (vlax-safearray-fill
  16.    (vlax-make-safearray
  17.     vlax-vbVariant
  18.     (cons 0 (1- (length Datalist)))
  19.    )
  20.    DataList
  21.   )
  22. )
  23. )
  24. )
  25. (MySetXrec
  26. (vla-AddXRecord
  27.   (vla-Add
  28.    (vla-get-Dictionaries
  29.     (vla-get-ActiveDocument
  30.      (vlax-get-Acad-Object)
  31.     )
  32.    )
  33.    "LisptoVBA"
  34.   )
  35.   "LisptoVBA"
  36. )
  37. '(1 2)
  38. '("Testing" "Again")
  39. )

回复

使用道具 举报

28

主题

249

帖子

7

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
361
发表于 2006-7-18 13:37:24 | 显示全部楼层
未经测试<概念编码>但为了灵活性,我可能会这样编写GetXRecLisp--
  1. Public Function GetXRecLisp(dictname As String, _
  2.                             xrecname As String) _
  3.                             As AcadXRecord
  4.     Dim dict As AcadDictionary, _
  5.         xrec As AcadXRecord
  6.    
  7.     On Error GoTo GetXRecLispError
  8.     Set dict = ThisDrawing.Dictionaries.Item(dictname)
  9.     Set xrec = dict.Item(xrecname)
  10.     Set GetXRecLisp = xrec
  11.     Exit Function
  12.    
  13. GetXRecLispError:
  14.     Err.Clear
  15.     Set GetXRecLisp = Nothing
  16.     ''  caller tests for nothing result
  17. End Function
另请注意变量/标签命名(病例/特异性等)
保留您的,MP
回复

使用道具 举报

71

主题

928

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1230
发表于 2006-7-18 13:46:43 | 显示全部楼层
谢谢你,迈克尔 当我理解了我'我正在做 不过我还是一如既往地喜欢你的表演
你所说的应变量是什么意思;都是小写的吗 这是VBA喜欢的吗?
回复

使用道具 举报

28

主题

249

帖子

7

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
361
发表于 2006-7-18 13:51:39 | 显示全部楼层
我尝试/倾向于编码--sub/functions:大写,然后是camel case,例如GetSomeValue,局部变量:小写,然后是驼形,例如dictMain,模块/(类)成员变量:前缀为my,然后与sub相同,例如myCollection,小部件:前缀为abbrev。小部件类型,然后作为子部件,例如frmMain
这是个大话题,但很抱歉,我要去参加一个午餐会,再见!
回复

使用道具 举报

71

主题

928

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1230
发表于 2006-7-18 14:08:08 | 显示全部楼层
蒂姆,我或多或少遵循了议员的描述,但我认为这更像是一种个人品味,对你来说很好
至于你的错误,我认为是因为Dim#039;在GetXrecordData代码中,将数据类型设置为整数……当您得到某个数据时,Acad返回一个变量,我知道它'当你在放东西时,它会发出低沉的声音,但它'这就是他们决定使用的。所以试着把整数改成变量,我认为它会起作用……实际上在这里'这是我用来测试你的;SETX记录代码:
  1. Public Sub getXRec(ByRef XrecName As String)
  2. Dim DictCol As AcadDictionaries
  3. Dim MyDict As AcadDictionary
  4. Dim Xrec As AcadXRecord
  5. Dim DataType As Variant
  6. Dim Data As Variant
  7. Dim I As Integer
  8. Set DictCol = ThisDrawing.Dictionaries
  9. Set MyDict = DictCol.Add("VBAtoLisp")
  10. Set Xrec = MyDict.Item(XrecName)
  11. Xrec.GetXRecordData DataType, Data
  12. For I = 0 To UBound(Data)
  13.     Debug.Print DataType(I) & " - " & Data(I)
  14. Next
  15. End Sub
回复

使用道具 举报

28

主题

249

帖子

7

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
361
发表于 2006-7-18 14:24:01 | 显示全部楼层

  1. Public Sub ShowXrecData(ByRef Xrec As AcadXRecord)
  2. Dim DataType As Variant
  3. Dim Data As Variant
  4. Dim Cnt As Integer
  5. Set Xrec = GetXRecLisp
  6. Xrec.GetXRecordData DataType, Data
  7. For Cnt = 0 To UBound(Data)
  8.     Debug.Print Data(Cnt)
  9. Next
  10. End Sub
所以我把代码改成上面的样子 我如何让它运行,以便我可以测试它 我按了播放按钮,但它需要宏名称 这似乎是因为它是用一个论点定义的 当我试着把它放入一个没有参数的sub,并调用它时,它没有't工作
谢谢杰夫。
回复

使用道具 举报

28

主题

249

帖子

7

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
361
发表于 2006-7-18 14:31:55 | 显示全部楼层
您需要在调用此sub时将xrecord传递给它 另一种选择是去掉;ByRef Xrec As AcadXRecord“;并在该sub.中将其调暗;如果你这样做,你必须在字典集合中寻找字典,然后在字典中找到xrecord。
回复

使用道具 举报

28

主题

249

帖子

7

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
361
发表于 2006-7-18 14:33:35 | 显示全部楼层
鲍勃说了什么,但既然你在代码中得到了它,你就不&35;039;我不需要把它作为论点来传递。这是从你的另一个线程#039;s代码:
  1. Public Function GetXRecLisp() As AcadXRecord
  2. Dim DictCol As AcadDictionaries
  3. Dim MyDict As AcadDictionary
  4. Dim XRec As AcadXRecord
  5. Set DictCol = ThisDrawing.Dictionaries
  6. On Error GoTo MyError
  7. Set MyDict = DictCol.Item("VBAtoLisp")
  8. Set XRec = MyDict.Item("VBAtoLisp")
  9. Set GetXRecLisp = XRec
  10. Exit Function
  11. MyError:
  12.     MsgBox "Error " & Err.Number & " ( " & Err.Description & " )"
  13.    
  14. End Function
  15. Public Sub ShowXrecData()
  16. Dim DataType As Variant
  17. Dim Data As Variant
  18. Dim Cnt As Integer
  19. Dim XRec As AcadXRecord
  20. Set XRec = GetXRecLisp
  21. XRec.GetXRecordData DataType, Data
  22. For Cnt = 0 To UBound(Data)
  23.     MsgBox Data(Cnt)
  24. Next
  25. End Sub
  26. Sub test2()
  27. ShowXrecData
  28. End Sub
回复

使用道具 举报

71

主题

928

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1230
发表于 2006-7-18 14:39:58 | 显示全部楼层
谢谢你们三位 它现在正在工作 唐#039;我不知道我把它放在那里了 一定是在工作日早上很早就开始编码了。
回复

使用道具 举报

28

主题

249

帖子

7

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
361
发表于 2006-7-18 16:05:27 | 显示全部楼层
你没有'我不知道我花了多长时间终于找到了如何做到这一点 在这里搜索,还有帮助文件,但我现在有了,所以它'都很好 午餐时间到了。
回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-7-5 23:46 , Processed in 0.842522 second(s), 72 queries .

© 2020-2025 乐筑天下

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