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

winer3086

斑竹大人、各位大侠：
" R* }& l3 N# B/ p我希望在CAD退出的时候，判断CAD中是否有图素发生改变，如新增、修改、删除等，但不包括整个图形的缩放。

1. Private Sub AcadDocument_BeginClose()
   + \3 I& \& t' m7 q/ F% x8 [6 P
2. Dim doc As AcadDocument
   % z9 K; Q1 ]# U, {
3. Set doc = ThisDrawing.Application.ActiveDocument
   
4. If doc.Saved = False Then
   
5. MsgBox "已改变"
   
6. Else
   
7. MsgBox "未改变"
   
8. End If
   ! O8 S$ e" j% @; l+ s) C. |7 v
9. End Sub

复制代码

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

woaishuijia

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

1. 
   ' j; G6 o0 f; M0 A( |& U
2. '声明一个全局变量,用来记录是否发生修改
   
3. Dim B As Boolean
   
4. '在响应文档对象的BeginDocClose事件的代码中检查B变量记录的修改
   % n0 t/ X. S  P3 G- Q4 A' D& p
5. Private Sub AcadDocument_BeginDocClose(Cancel As Boolean)
   ( k' h7 B( k8 h4 H
6.     If B Then
   5 W2 S. H( S+ d, E6 K/ I  h7 s1 y( H( x7 M
7.         '当文档被修改时用消息框通知用户"已改变",当用户按下"取消"按钮时不关闭文档
   
8.         If MsgBox("已改变", vbOKCancel) = vbCancel Then Cancel = True
   ) X6 m0 F7 q5 C2 W& F
9.         '清空记录
   6 B, l) r* C9 o( X
10.         B = False
    
11.     Else
    # q% i' Z8 r8 I# c
12.         MsgBox "未改变"
    
13.     End If
    
14. End Sub
    
15. '在响应文档保存事件的代码中清空记录
    
16. Private Sub AcadDocument_EndSave(ByVal FileName As String)
    
17.     B = False
    
18. End Sub
    * R) B) [- Z& [7 C0 \
19. '在响应文档对象的ObjectAdded事件(对象被添加到图形中时触发)的代码中记录文档修改
    3 U7 k* w1 D8 k1 ?3 m4 T  w
20. '可以在代码中检查Object参数的对象类型,以了解是哪一类对象被添加.
    
21. 'ObjectModified事件代码也一样
    + U$ S( v$ e* E7 v
22. Private Sub AcadDocument_ObjectAdded(ByVal Object As Object)
    & k. V' ~9 D- E2 U+ `6 K( s8 ]
23.     B = True
    
24. End Sub
    * d' r. H5 \1 C! T+ W, u' }
25. '在响应文档对象的ObjectErased事件(对象从图形中删除时触发)的代码中记录文档修改
    
26. Private Sub AcadDocument_ObjectErased(ByVal ObjectID As Long)
    $ N1 @2 u- c2 [; Y: W
27.     B = True
    # G# _- f0 N3 c: o( m1 O. N
28. End Sub
    ! |! L" V1 f* l
29. '在响应文档对象的ObjectModified事件(图形中的对象被修改时触发)的代码中记录文档修改
    
30. Private Sub AcadDocument_ObjectModified(ByVal Object As Object)
    
31.     B = True
    & b& z( d# [+ K4 ?  c4 k
32. End Sub
    

复制代码

winer3086

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

winer3086

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

" y; P& B* ~2 j+ ]' h4 m; I# O以后我得好好向您学习呢！

woaishuijia

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