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

newer

问题：

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

Option Explicit<br /> <br /> Dim cIDs As New Collection ' collection for line IDs to be modified<br /> Dim bFlag As Boolean   ' flag to indicate when modification needed<br /> Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)  <br />   ' Here we can set the flag ONLY for particular command.<br />   ' For simplicity, set always in this sample<br />   bFlag = True<br />   Call ClearCollection(cIDs)'Just in case<br />                             '(done already in EndCommand)<br /> End Sub<br /> Private Sub AcadDocument_ObjectAdded(ByVal Object As Object)  <br />   If bFlag Then ' If flag on and line - add the ID to the collection<br />       Dim obj As AcadObject  <br />       Set obj = Object  <br />       If obj.ObjectName = "AcDbLine" Then    <br />           cIDs.Add obj.ObjectID  <br />       End If<br />   End If<br /> End Sub<br /> Private Sub AcadDocument_EndCommand(ByVal CommandName As String)  <br />   ' Set all line start points to origin and color to magenta<br />   If bFlag Then<br />     Dim pntO(0 To 2) As Double  <br />     pntO(0) = 0#: pntO(1) = 0#: pntO(2) = 0#      <br />     Dim id As Variant  <br />     For Each id In cIDs    <br />       Dim line As AcadLine    <br />       Set line = ThisDrawing.ObjectIdToObject(id)    <br />       line.StartPoint = pntO    <br />       line.Color = acMagenta  <br />     Next id      <br />     ' Reset flag and collection  <br />     bFlag = False  <br />     Call ClearCollection(cIDs)<br />   End If<br /> End Sub<br /> Private Sub ClearCollection(cCol As Collection)<br />   Dim iCnt As Long<br />   For iCnt = 1 To cCol.Count  <br />     cCol.Remove 1 ' Since collections are reindexed<br />                   'automatically, remove the first member<br />   Next iCntEnd<br /> End Sub<br />