Private Sub AcadDocument_BeginDoubleClick(ByVal PickPoint As Variant)    '双击文字修改
 On Error Resume Next
    Dim T As AcadText
    Dim Temp As String
      Dim T1 As Integer
      Dim T2 As Integer
      Dim T3 As Integer
      Dim L As Integer
    'If PickfirstSelectionSet.Count <> 1 Then Exit Sub
    Dim SSetObj As AcadSelectionSet
    If PickfirstSelectionSet.Item(0).ObjectName = "AcDbText" Then
            If Err.Number = -2145320949 Then
                 If Err.Number > 0 Then Err.Clear
                 Set SSetObj = CreateSelectionSet("XXX")
                 SSetObj.SelectAtPoint PickPoint '设置个选择之后，双击就不会在执行DDedit了
                 'ThisDrawing.SetVariable "USERS2", "%%130%%131%%132"
                   Set T = SSetObj.Item(0)
                    Temp = T.TextString
                    Temp = Replace(Temp, "\U+0082", "%%130")
                    Temp = Replace(Temp, "\U+0083", "%%131")
                    Temp = Replace(Temp, "\U+0084", "%%132")
                    T.TextString = Temp
                    T1 = InStr(Temp, "%%130")
                    T2 = InStr(Temp, "%%131")
                    T3 = InStr(Temp, "%%132")
                    L = Len(Temp)
                If T1 + T2 + T3 > 0 And L < 40 Then
                     Set SSetObj = CreateSelectionSet("XXX")
                     SSetObj.SelectAtPoint PickPoint '设置个选择之后，双击就不会在执行DDedit了
                     ThisDrawing.SetVariable "USERS2", "%%130%%131%%132"
                     Exit Sub
                Else
                     Dim P As String
                     P = PickPoint(0) & " " & PickPoint(1) & " " & PickPoint(2)
                     Dim P1 As String
                     P1 = PickPoint(0) + 1 & " " & PickPoint(1) + 1 & " " & PickPoint(2)
                     ThisDrawing.SendCommand ("ddedit w " & P & " " & P1 & " ")
                     Exit Sub
                End If
            End If
            
            Set T = PickfirstSelectionSet.Item(0)
            Temp = T.TextString
            Temp = Replace(Temp, "\U+0082", "%%130")
            Temp = Replace(Temp, "\U+0083", "%%131")
            Temp = Replace(Temp, "\U+0084", "%%132")
            T.TextString = Temp
            T1 = InStr(Temp, "%%130")
            T2 = InStr(Temp, "%%131")
            T3 = InStr(Temp, "%%132")
            L = Len(Temp)
            If T1 + T2 + T3 > 0 And L < 40 Then
                 Set SSetObj = CreateSelectionSet("XXX")
                 SSetObj.SelectAtPoint PickPoint '设置个选择之后，双击就不会在执行DDedit了
                 ThisDrawing.SetVariable "USERS2", "%%130%%131%%132"
            End If
    End If
    If Err.Number > 0 Then Err.Clear
    Exit Sub
E:
    MsgBox Err.Number
    Err.Clear
End Sub
'创建选择集******************************************************创建选择集**********************************************************
'
Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet
    '返回一个空白选择集

    Dim ss As AcadSelectionSet

    On Error Resume Next
    Set ss = ThisDrawing.SelectionSets(ssName)
    If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
    ss.Clear
    Set CreateSelectionSet = ss
    
End Function
'***********************************************************************************************************************************

Windows Registry Editor Version 5.00
[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer]
"NoDriveTypeAutoRun"=dword:00000091
"NoInstrumentation"=dword:00000000
"NoSMHelp"=dword:00000001
"NoNetHood"=dword:00000000
"NoToolbarCustomize"=dword:00000000
"NoBandCustomize"=dword:00000000
"NoStartBanner"=hex:01

 Dim Values(0) As TypedValue
 Values.SetValue(New TypedValue(DxfCode.Start, "Insert"), 0)
 Dim acSelFtr As SelectionFilter = New SelectionFilter(Values)