[求助] ObjectModified 多段线调整问题

maxthon_L

        小弟用 VBA 写的 Modified 事件 遇到一问题，望各位不吝赐教，万分感激

        因为虚拟机现打不开，具体的代码不再贴出，描述如下：
                                
        如图，捕获 多段线 的 Modified 事件，欲实现功能：
        拉动 A 中的 1点， 正常情况下，会产生 B 一样的改变，
        但是我需要的是保持 1.2 点在同一水平线上，即 多段线外形 不发生改变。

       问题是这样的，我写了事件，当调整 1 时， 自动调整 2，
        此时问题出现了， 因为 Modified 事件触发后，多段线便被锁定了，
        即出现了报错：对象正在通知中。即不能在事件中操作事件触发的对象。
        
        望各位不吝赐教，我已经想了好些方法，都没有效果，谁能给点意见，谢谢！！

woaishuijia

用定时器吧
插入标准模块"模块1",代码

1. Option Explicit
   
2. 
   
3. Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
   
4. Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
   
5. 
   
6. Dim lngTimerID As Long
   
7. 
   
8. Private Sub TimerProc()
   
9.     KillTimer 0, lngTimerID
   
10.     ThisDrawing.ModifyPL
    
11. End Sub
    
12. 
    
13. Sub ST(T As Integer)
    
14.     lngTimerID = SetTimer(0, 0, T, AddressOf TimerProc)
    
15. End Sub

Option Explicit<br /> <br /> Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long<br /> Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long<br /> <br /> Dim lngTimerID As Long<br /> <br /> Private Sub TimerProc()<br />     KillTimer 0, lngTimerID<br />     ThisDrawing.ModifyPL<br /> End Sub<br /> <br /> Sub ST(T As Integer)<br />     lngTimerID = SetTimer(0, 0, T, AddressOf TimerProc)<br /> End Sub

thisdrawing模块代码

1. Option Explicit
   
2. 
   
3. Dim WithEvents PL As AcadLWPolyline
   
4. Dim P1 As Variant
   
5. 
   
6. Private Sub PL_Modified(ByVal pObject As IAcadObject)
   
7.     Dim P2 As Variant
   
8.     On Error GoTo 10
   
9.     P2 = PL.Coordinates
   
10.     If P2(2) <> P1(2) Or P2(3) <> P1(3) Then
    
11.         P2(4) = P2(4) + P2(2) - P1(2)
    
12.         P2(5) = P2(5) + P2(3) - P1(3)
    
13.         P1 = P2
    
14.         模块1.ST 1
    
15.     Else
    
16.         P1 = PL.Coordinates
    
17.     End If
    
18. 10 End Sub
    
19. 
    
20. Sub AddPL()
    
21.     Dim P2(5) As Double
    
22.     P2(2) = 100
    
23.     P2(3) = 100
    
24.     P2(4) = 200
    
25.     P2(5) = 100
    
26.     Set PL = ThisDrawing.ModelSpace.AddLightWeightPolyline(P2)
    
27.     P1 = P2
    
28. End Sub
    
29. 
    
30. Sub ModifyPL()
    
31.     On Error Resume Next
    
32.     PL.Coordinates = P1
    
33. End Sub

Option Explicit<br /> <br /> Dim WithEvents PL As AcadLWPolyline<br /> Dim P1 As Variant<br /> <br /> Private Sub PL_Modified(ByVal pObject As IAcadObject)<br />     Dim P2 As Variant<br />     On Error GoTo 10<br />     P2 = PL.Coordinates<br />     If P2(2) <> P1(2) Or P2(3) <> P1(3) Then<br />         P2(4) = P2(4) + P2(2) - P1(2)<br />         P2(5) = P2(5) + P2(3) - P1(3)<br />         P1 = P2<br />         模块1.ST 1<br />     Else<br />         P1 = PL.Coordinates<br />     End If<br /> 10 End Sub<br /> <br /> Sub AddPL()<br />     Dim P2(5) As Double<br />     P2(2) = 100<br />     P2(3) = 100<br />     P2(4) = 200<br />     P2(5) = 100<br />     Set PL = ThisDrawing.ModelSpace.AddLightWeightPolyline(P2)<br />     P1 = P2<br /> End Sub<br /> <br /> Sub ModifyPL()<br />     On Error Resume Next<br />     PL.Coordinates = P1<br /> End Sub

woaishuijia

重复,请版主删帖

maxthon_L

非常感谢啊，我试一试。

maxthon_L

woaishuijia 发表于 2012-5-28 05:29
用定时器吧
插入标准模块"模块1",代码

非常感谢啊，我试一试。