maxthon_L 发表于 2012-5-25 17:52:35

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

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

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

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


woaishuijia 发表于 2012-5-28 05:28:33

本帖最后由 woaishuijia 于 2012-6-2 05:26 编辑

用定时器吧
插入标准模块"模块1",代码
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模块代码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

woaishuijia 发表于 2012-5-28 05:29:20

本帖最后由 woaishuijia 于 2012-6-2 05:28 编辑

重复,请版主删帖

maxthon_L 发表于 2012-5-31 14:13:38

非常感谢啊，我试一试。

maxthon_L 发表于 2012-5-31 14:15:23

woaishuijia 发表于 2012-5-28 05:29 static/image/common/back.gif
用定时器吧
插入标准模块"模块1",代码



非常感谢啊，我试一试。
页: [1]
查看完整版本: [求助] ObjectModified 多段线调整问题