找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1645|回复: 0

如何像在文本对象ObjectAdded事件,在VBA中修改一个图形对象

[复制链接]

已领礼包: 40个

财富等级: 招财进宝

发表于 2021-1-26 16:22:58 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
问题:

How to modify a drawing object inside a VBA event handler like the document object’s ObjectAdded event

解答:

Consider this: Using WithEvents in VB(A), you are trying to modify an object passed to the document's ObjectAdded, ObjectModified events, or drawing object's Modified event. However, this results in Error that look similar to this: "Object was opened for read" or similar. How can you work around this?

Firstly, modifying objects in events such as these is generally not recommended and not worth the trouble you might face later; especially if you are trying to modify objects that are already in the process of being modified. That is rarely a good idea.

However, if you absolutely need to modify objects in event handlers, there are some ways to achieve it.

ActiveX events are modeled on ObjectARX Event handling mechanism (reactors). There are many notifications when object is in an open state (for Read, Write or Notify) so in general, you cannot change it from within the event, evidenced by the fact for instance that the object is passed ByVal to the ObjectAdded event. You can however access any object for write in the CommandEnded event. So, you can set some global flags, trigger them in CommandStart, store ObjectIds during ObjectAdded and use the Ids in CommandEnded to change the relevant objects. For example, the code below will alter any line added to the document. This is the solution specific to VBA. For VB you have additional complexity of attaching events to docs (but that is a topic for another blog post).

下面是VBA代码

  1. Option Explicit

  2. Dim cIDs As New Collection ' collection for line IDs to be modified
  3. Dim bFlag As Boolean   ' flag to indicate when modification needed
  4. Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)  
  5.   ' Here we can set the flag ONLY for particular command.
  6.   ' For simplicity, set always in this sample
  7.   bFlag = True
  8.   Call ClearCollection(cIDs)'Just in case
  9.                             '(done already in EndCommand)
  10. End Sub
  11. Private Sub AcadDocument_ObjectAdded(ByVal Object As Object)  
  12.   If bFlag Then ' If flag on and line - add the ID to the collection
  13.       Dim obj As AcadObject  
  14.       Set obj = Object  
  15.       If obj.ObjectName = "AcDbLine" Then   
  16.           cIDs.Add obj.ObjectID  
  17.       End If
  18.   End If
  19. End Sub
  20. Private Sub AcadDocument_EndCommand(ByVal CommandName As String)  
  21.   ' Set all line start points to origin and color to magenta
  22.   If bFlag Then
  23.     Dim pntO(0 To 2) As Double  
  24.     pntO(0) = 0#: pntO(1) = 0#: pntO(2) = 0#      
  25.     Dim id As Variant  
  26.     For Each id In cIDs   
  27.       Dim line As AcadLine   
  28.       Set line = ThisDrawing.ObjectIdToObject(id)   
  29.       line.StartPoint = pntO   
  30.       line.Color = acMagenta  
  31.     Next id      
  32.     ' Reset flag and collection  
  33.     bFlag = False  
  34.     Call ClearCollection(cIDs)
  35.   End If
  36. End Sub
  37. Private Sub ClearCollection(cCol As Collection)
  38.   Dim iCnt As Long
  39.   For iCnt = 1 To cCol.Count  
  40.     cCol.Remove 1 ' Since collections are reindexed
  41.                   'automatically, remove the first member
  42.   Next iCntEnd
  43. End Sub


论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-12-14 17:30 , Processed in 0.354483 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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