乐筑天下

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

在VBA中绘制对象的顺序...

[复制链接]

46

主题

118

帖子

23

银币

后起之秀

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

铜币
291
发表于 2008-2-20 09:30:15 | 显示全部楼层 |阅读模式
嗨,
有没有办法排序VBA创建的对象的绘制顺序?
基本上........
  1. ' Check for correct titleblocks..
  2. Select Case entX.Name
  3.         Case "A3 - AbiCAD Titleblock"
  4.                 A3logo_IP(0) = 9.442: A3logo_IP(1) = 5: A3logo_IP(2) = 0
  5.                 Set blockLOGO_A3 = ThisDrawing.Blocks.Item("A3 - AbiCAD Titleblock").InsertBlock(A3logo_IP, LogoPath, 1#, 1#, 1#, 0)
  6.                 blockLOGO_A3.Layer = "ABI-BORDER"
  7.                 blockLOGO_A3.Update
  8.                 GoTo RUN_TBE
  9. End Select

....当用户选择一个客户名称时,它会将该徽标插入主标题栏,但有些徽标是彩色的,应该位于主标题栏边框线的后面..
在VBA,这些块对象没有draworder属性,或者有其他方法可以做到这一点吗?
有什么想法吗?干杯,保罗代码1]
P4 3.0Ghz / 2GB内存
XP Pro SP2
蓝宝石X1950 512MB双DVi显卡..
AutoCAD 2008..

本帖以下内容被隐藏保护;需要你回复后,才能看到!

游客,如果您要查看本帖隐藏内容请回复
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2008-2-20 09:51:09 | 显示全部楼层
AcadSortentsTable,这方面的帮助也很好。
回复

使用道具 举报

46

主题

118

帖子

23

银币

后起之秀

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

铜币
291
发表于 2008-2-20 11:42:03 | 显示全部楼层
嗨,
已经研究了它,并从网络上的其他地方复制了一些代码(红色)并修改了它以达到我自己的目的:
  1. Private Sub cmdUpdateTitleblock_click()
  2. [color=red]'Draworder the LOGO to the back..
  3. Dim eDictionary As Object
  4. Dim sentityObj As Object
  5. Dim A3_STB(0), A2_STB(0), A1_STB(0) As AcadObject
  6. Set eDictionary = ThisDrawing.PaperSpace.GetExtensionDictionary
  7. Set sentityObj = eDictionary.GetObject("ACAD_SORTENTS")
  8. Set sentityObj = eDictionary.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")[/color]
  9. ' Loop through every layout in the drawing..
  10. ThisDrawing.ActiveSpace = acPaperSpace
  11. For Each layoutX In ThisDrawing.Layouts
  12. If layoutX.Name  "Model" Then 'Disregard ModelSpace..
  13. ThisDrawing.ActiveLayout = layoutX
  14.    
  15. ' Start main loop to get attribute values for the attributes..
  16. For Each entX In ThisDrawing.PaperSpace
  17.     ' If the found object is a block..
  18. If entX.EntityName = "AcDbBlockReference" Then
  19. ' Check for correct titleblocks and insert logos. Also, set draworder for blocks to movetobottom..
  20. Select Case entX.Name
  21.         Case "A1 - AbiCAD Titleblock"
  22.                 A1logo_IP(0) = 446.415: A1logo_IP(1) = 17.085: A1logo_IP(2) = 0
  23.                 Set blockLOGO_A1 = ThisDrawing.Blocks.Item("A1 - AbiCAD Titleblock").InsertBlock(A1logo_IP, LogoPath, 1#, 1#, 1#, 0)
  24.                 blockLOGO_A1.Layer = "ABI-BORDER"
  25.                 blockLOGO_A1.Update
  26.                 [color=red]Set A1_STB(0) = blockLOGO_A1
  27.                 sentityObj.MoveToBottom A1_STB[/color]
  28.                 AcadApplication.Update
  29.                 GoTo RUN_TBE
  30.                
  31.         Case "A2 - AbiCAD Titleblock"
  32.                 A2logo_IP(0) = 183.049: A2logo_IP(1) = 5: A2logo_IP(2) = 0
  33.                 Set blockLOGO_A2 = ThisDrawing.Blocks.Item("A2 - AbiCAD Titleblock").InsertBlock(A2logo_IP, LogoPath, 1#, 1#, 1#, 0)
  34.                 blockLOGO_A2.Layer = "ABI-BORDER"
  35.                 blockLOGO_A2.Update
  36.                 [color=red]Set A2_STB(0) = blockLOGO_A2
  37.                 sentityObj.MoveToBottom A2_STB[/color]
  38.                 AcadApplication.Update
  39.                 GoTo RUN_TBE
  40.                
  41.         Case "A3 - AbiCAD Titleblock"
  42.                 A3logo_IP(0) = 9.442: A3logo_IP(1) = 5: A3logo_IP(2) = 0
  43.                 Set blockLOGO_A3 = ThisDrawing.Blocks.Item("A3 - AbiCAD Titleblock").InsertBlock(A3logo_IP, LogoPath, 1#, 1#, 1#, 0)
  44.                 blockLOGO_A3.Layer = "ABI-BORDER"
  45.                 blockLOGO_A3.Update
  46.                 [color=red]Set A3_STB(0) = blockLOGO_A3
  47.                 sentityObj.MoveToBottom A3_STB[/color]
  48.                 AcadApplication.Update
  49.                 GoTo RUN_TBE
  50. End Select
  51.             
  52. RUN_TBE:
  53. 'blah blah blah more code here for other stuff...
  54. End Sub

....但是这段代码在'sentityObj.MoveToBottom A3_STB','sentityObj.MoveToBottom A2_STB'和'sentityObj.MoveToBottom A1_STB'行上触底反弹,指出:
'无效输入'
可能出了什么问题?是将徽标块插入到另一个块(嵌套块)中,还是有一个简单的解决方案?
有什么想法吗?
干杯,
保罗
基点设计有限公司。
P4 3.0Ghz / 2GB 内存
XP Pro SP2
蓝宝石 X1950 512MB 双 DVi 显卡。
AutoCAD 2008..
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2008-2-20 12:20:51 | 显示全部楼层
试着做一个函数
但是,首先尝试一下“帮助”的功能,我认为您可能需要学习编程基础知识
首先,你要弄清楚怎么做,然后再弄清楚如何使之适应你正在编写的特定代码。
对每个人来说,这都需要时间。
回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-7-5 08:47 , Processed in 0.982998 second(s), 60 queries .

© 2020-2025 乐筑天下

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