数据修改事件 特定半径圆自动加中心线

qq2222081387

1. 之前用lisp写过没达到想要的效果，看到VBA字典的资料所以转VBA了

复制代码

qq2222081387

2. Dim Czxx As New Dictionary
   
3. Private Sub AcadDocument_ObjectModified(ByVal Object As Object)
   
4.     Dim Str As String
   
5.     Dim ptC As Variant
   
6.     Dim ptC1(2) As Double
   
7.     Dim ptC2(2) As Double
   
8.     Dim Obj As Object
   
9.     Dim Jubc As String
   
10.     Dim Jubl1 As String
    
11.     Dim Jubl2 As String
    
12.     Str = Object.ObjectName
    
13.     If StrComp(Str, "AcDbCircle", vbTextCompare) = 0 Then
    
14.         Jubc = Object.Handle
    
15.         If Czxx.Exists(Jubc) Then
    
16.             Dim Val As Variant
    
17.             Str = Czxx.Item(Jubc)
    
18.             Val = Split(Str, "|")
    
19.             Set Obj = ThisDrawing.HandleToObject(Val(0))
    
20.             Obj.Delete
    
21.             Set Obj = ThisDrawing.HandleToObject(Val(1))
    
22.             Obj.Delete
    
23.             Czxx.Remove (Jubc)
    
24.             If Object.radius = 5 Then
    
25.                 ptC = Object.Center '»ñè¡Ô2DÄ×ø±ê
    
26.                 ptC1(0) = ptC(0) - 8: ptC1(1) = ptC(1): ptC1(2) = ptC(2)
    
27.                 ptC2(0) = ptC(0) + 8: ptC2(1) = ptC(1): ptC2(2) = ptC(2)
    
28.                 Set Obj = ThisDrawing.ModelSpace.Addline(ptC1, ptC2) 'ÖDDÄÏß1 oá
    
29.                 Jubl1 = Obj.Handle
    
30.                 ptC1(0) = ptC(0): ptC1(1) = ptC(1) + 8: ptC1(2) = ptC(2)
    
31.                 ptC2(0) = ptC(0): ptC2(1) = ptC(1) - 8: ptC2(2) = ptC(2)
    
32.                 Set Obj = ThisDrawing.ModelSpace.Addline(ptC1, ptC2) 'ÖDDÄÏß2 êú
    
33.                 Jubl2 = Obj.Handle
    
34.                 Set Czxx = CreateObject("Scripting.Dictionary")
    
35.                 Czxx(Jubc) = Jubl1 & "|" & Jubl2
    
36.             End If
    
37.         Else
    
38.             If Object.radius = 5 Then
    
39.                 Jubc = Object.Handle
    
40.                 ptC = Object.Center
    
41.                 ptC1(0) = ptC(0) - 8: ptC1(1) = ptC(1): ptC1(2) = ptC(2)
    
42.                 ptC2(0) = ptC(0) + 8: ptC2(1) = ptC(1): ptC2(2) = ptC(2)
    
43.                 Set Obj = ThisDrawing.ModelSpace.Addline(ptC1, ptC2)
    
44.                 Jubl1 = Obj.Handle
    
45.                 ptC1(0) = ptC(0): ptC1(1) = ptC(1) + 8: ptC1(2) = ptC(2)
    
46.                 ptC2(0) = ptC(0): ptC2(1) = ptC(1) - 8: ptC2(2) = ptC(2)
    
47.                 Set Obj = ThisDrawing.ModelSpace.Addline(ptC1, ptC2)
    
48.                 Jubl2 = Obj.Handle
    
49.                 Set Czxx = CreateObject("Scripting.Dictionary")
    
50.                 Czxx(Jubc) = Jubl1 & "|" & Jubl2
    
51.             End If
    
52.         End If
    
53.     End If
    
54. End Sub
    
55. 
    

Dim Czxx As New Dictionary<br /> Private Sub AcadDocument_ObjectModified(ByVal Object As Object)<br />     Dim Str As String <br />     Dim ptC As Variant<br />     Dim ptC1(2) As Double<br />     Dim ptC2(2) As Double<br />     Dim Obj As Object<br />     Dim Jubc As String<br />     Dim Jubl1 As String<br />     Dim Jubl2 As String<br />     Str = Object.ObjectName<br />     If StrComp(Str, "AcDbCircle", vbTextCompare) = 0 Then <br />         Jubc = Object.Handle<br />         If Czxx.Exists(Jubc) Then<br />             Dim Val As Variant<br />             Str = Czxx.Item(Jubc)<br />             Val = Split(Str, "|")<br />             Set Obj = ThisDrawing.HandleToObject(Val(0))<br />             Obj.Delete<br />             Set Obj = ThisDrawing.HandleToObject(Val(1))<br />             Obj.Delete<br />             Czxx.Remove (Jubc)<br />             If Object.radius = 5 Then <br />                 ptC = Object.Center '&#187;&#241;è&#161;&#212;2D&#196;×&#248;±ê<br />                 ptC1(0) = ptC(0) - 8: ptC1(1) = ptC(1): ptC1(2) = ptC(2)<br />                 ptC2(0) = ptC(0) + 8: ptC2(1) = ptC(1): ptC2(2) = ptC(2)<br />                 Set Obj = ThisDrawing.ModelSpace.Addline(ptC1, ptC2) '&#214;DD&#196;&#207;&#223;1 oá<br />                 Jubl1 = Obj.Handle<br />                 ptC1(0) = ptC(0): ptC1(1) = ptC(1) + 8: ptC1(2) = ptC(2)<br />                 ptC2(0) = ptC(0): ptC2(1) = ptC(1) - 8: ptC2(2) = ptC(2)<br />                 Set Obj = ThisDrawing.ModelSpace.Addline(ptC1, ptC2) '&#214;DD&#196;&#207;&#223;2 êú<br />                 Jubl2 = Obj.Handle<br />                 Set Czxx = CreateObject("Scripting.Dictionary")<br />                 Czxx(Jubc) = Jubl1 & "|" & Jubl2<br />             End If<br />         Else <br />             If Object.radius = 5 Then <br />                 Jubc = Object.Handle<br />                 ptC = Object.Center <br />                 ptC1(0) = ptC(0) - 8: ptC1(1) = ptC(1): ptC1(2) = ptC(2)<br />                 ptC2(0) = ptC(0) + 8: ptC2(1) = ptC(1): ptC2(2) = ptC(2)<br />                 Set Obj = ThisDrawing.ModelSpace.Addline(ptC1, ptC2)<br />                 Jubl1 = Obj.Handle<br />                 ptC1(0) = ptC(0): ptC1(1) = ptC(1) + 8: ptC1(2) = ptC(2)<br />                 ptC2(0) = ptC(0): ptC2(1) = ptC(1) - 8: ptC2(2) = ptC(2)<br />                 Set Obj = ThisDrawing.ModelSpace.Addline(ptC1, ptC2)<br />                 Jubl2 = Obj.Handle<br />                 Set Czxx = CreateObject("Scripting.Dictionary")<br />                 Czxx(Jubc) = Jubl1 & "|" & Jubl2<br />             End If<br />         End If<br />     End If<br /> End Sub<br /> <br />

zyclyl

这段代码该怎么用呀

qq2222081387

zyclyl 发表于 2018-12-13 08:09
这段代码该怎么用呀

工具-引用-浏览-找到scrrun.dll-确认
然后代码放在 Thisdrawing 里面就可以了
画直径10的圆就可以看见变化了