'重命名图块
Sub ReNameBLock()
    On Error Resume Next
    Dim E As AcadEntity
    Dim P As Variant
    Dim B As AcadBlockReference
    ThisDrawing.Utility.GetEntity E, P, "选择一个你要重命名的参照块: "
    If Err <> 0 Then Exit Sub
    Dim NewName As String
    NewName = InputBox("输入新的图块名称:", "田草结构工具箱")
    If NewName = "" Then Exit Sub
    If Err = 0 Then
        If E.ObjectName = "AcDbBlockReference" Then
            Set B = E
            ThisDrawing.Blocks(B.name).name = NewName
        End If
    End If
End Sub