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

maxthon_L · 发表于 2012-5-25 17:52:00

小弟用 VBA 写的 Modified 事件遇到一问题，望各位不吝赐教，万分感激
因为虚拟机现打不开，具体的代码不再贴出，描述如下：

ymy23t2nkwd.JPG

      如图，捕获多段线的 Modified 事件，欲实现功能：
      拉动 A 中的 1点，正常情况下，会产生 B 一样的改变，
      但是我需要的是保持 1.2 点在同一水平线上，即多段线外形不发生改变。
      问题是这样的，我写了事件，当调整 1 时，自动调整 2，
      此时问题出现了，因为 Modified 事件触发后，多段线便被锁定了，
      即出现了报错：对象正在通知中。即不能在事件中操作事件触发的对象。

      望各位不吝赐教，我已经想了好些方法，都没有效果，谁能给点意见，谢谢！！

woaishuijia · 发表于 2012-5-28 05:28:00

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

copy

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

thisdrawing模块代码

copy

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