如何判断CAD中有图素发生改变

winer3086

7 r0 {, Z( f6 I
& k# t" Y( d: \. V% _" l+ P8 t% {斑竹大人、各位大侠：
我希望在CAD退出的时候，判断CAD中是否有图素发生改变，如新增、修改、删除等，但不包括整个图形的缩放。

1. Private Sub AcadDocument_BeginClose()
   9 ]& d8 M  Q$ _2 L& l8 X
2. Dim doc As AcadDocument
   
3. Set doc = ThisDrawing.Application.ActiveDocument
   % o6 z/ N; `9 K) }9 T9 e
4. If doc.Saved = False Then
   . z' |4 i: S# N% r+ t$ S$ A: h$ ^9 V4 D
5. MsgBox "已改变"
   , V4 h! ]" v- \9 B" ^( x
6. Else
   % T0 J3 m0 n  w; g( e9 U
7. MsgBox "未改变"
   - l" n3 {. ?' }* o
8. End If
   # u7 i& |# t# X/ g; ?- s
9. End Sub

复制代码

现在有个问题，即使是滚动鼠标滚轮，缩放一下图形，都会认为已经发生改变。我该怎么办呢？

woaishuijia

要求得越细致,代码就会越复杂,呵呵

1. 
   3 ^, I- T# @1 X1 k4 ]
2. '声明一个全局变量,用来记录是否发生修改
   
3. Dim B As Boolean
   . u; ~6 Q( e+ b+ G* D
4. '在响应文档对象的BeginDocClose事件的代码中检查B变量记录的修改
   ' f! B1 r+ F; E9 @* C9 l9 {3 E
5. Private Sub AcadDocument_BeginDocClose(Cancel As Boolean)
   
6.     If B Then
   
7.         '当文档被修改时用消息框通知用户"已改变",当用户按下"取消"按钮时不关闭文档
   
8.         If MsgBox("已改变", vbOKCancel) = vbCancel Then Cancel = True
   9 X% g) d% M2 O; |+ L
9.         '清空记录
   
10.         B = False
    ) W) V1 q- R+ Y
11.     Else
    
12.         MsgBox "未改变"
    , |* s$ X5 }# D+ e1 I' C
13.     End If
    ' f% L5 R; W/ X( W
14. End Sub
    % d5 Q( W, o' G! o% P2 h
15. '在响应文档保存事件的代码中清空记录
    
16. Private Sub AcadDocument_EndSave(ByVal FileName As String)
    , v* L; f8 q3 w. w' {+ o
17.     B = False
    
18. End Sub
    
19. '在响应文档对象的ObjectAdded事件(对象被添加到图形中时触发)的代码中记录文档修改
    
20. '可以在代码中检查Object参数的对象类型,以了解是哪一类对象被添加.
    
21. 'ObjectModified事件代码也一样
    ; R- q" v8 x* R  `6 p  v; J# t  Z) `
22. Private Sub AcadDocument_ObjectAdded(ByVal Object As Object)
    
23.     B = True
    
24. End Sub
    
25. '在响应文档对象的ObjectErased事件(对象从图形中删除时触发)的代码中记录文档修改
    
26. Private Sub AcadDocument_ObjectErased(ByVal ObjectID As Long)
    
27.     B = True
    
28. End Sub
    
29. '在响应文档对象的ObjectModified事件(图形中的对象被修改时触发)的代码中记录文档修改
    + E3 w  z2 B8 f9 H2 m0 e6 F: a
30. Private Sub AcadDocument_ObjectModified(ByVal Object As Object)
    
31.     B = True
    
32. End Sub
    

复制代码

winer3086

老大，你太厉害啦，不管我提什么问题，你总能在第一时间给我答复。太感谢了，帮了我很大的忙！

winer3086

老大，你太厉害啦，不管我提什么问题，你总能在第一时间给我答复。太感谢了，帮了我很大的忙！
winer3086 发表于 2010-9-5 22:32 http://www.3dportal.cn/discuz/images/common/back.gif

  [/ {: U* a" @6 \以后我得好好向您学习呢！

woaishuijia

不用客气,来以这里都是朋友,呵呵.