Attribute VB_Name = "Module1"
Option Explicit
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long




Public acadStarted As Boolean
Public acadApp As New AcadApplication
Public acadDoc As AcadDocument
Public Sub FinalRelease()
    If Not acadApp Is Nothing Then Set acadApp = Nothing

End Sub
Sub Main()
'MsgBox ("0000")

Dim myObj As AcadObject
Dim a_strArgs() As String
Dim blnDebug As Boolean
Dim strFileName As String
Dim I As Integer
Dim dwgFile As String
Dim dataFile As String
Dim isMultiView As String, isMultiLayout As String, isMultiLayer As String, isMultiSheet As String, paperSize As String
Dim Line As Variant
Dim Values As Variant
Dim Value As Variant
Dim subvalue As Variant
Dim txtFileName As String
Dim Attrs As Variant
Dim J As Integer
Dim myReference As AcadBlockReference
Dim myReference_1 As AcadBlockReference



  
  txtFileName = ""
a_strArgs = Split(Command$, "   ")
For I = LBound(a_strArgs) To UBound(a_strArgs)
    Select Case I
    Case 0:
    dwgFile = a_strArgs(I)
    Case 1:
    txtFileName = a_strArgs(I)

    End Select
Next





On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application")
If Err Then
    Set acadApp = CreateObject("AutoCAD.Application")
    acadStarted = False
    If Err Then
        MsgBox Err.Description
        'Err.Description
        Exit Sub
    End If
End If

'MsgBox ("222")
Dim oldDoc As AcadDocument
Dim Opened As Boolean
Opened = False
'acadApp.Visible = False
'MsgBox dwgFile

For Each oldDoc In acadApp.Documents
    'MsgBox oldDoc.FullName
    If oldDoc.FullName <> "" Then
        If InStr(LCase(dwgFile), LCase(oldDoc.FullName)) <> 0 Then
            'MsgBox oldDoc.FullName
            Opened = True
            oldDoc.Activate
           ' Set acadApp.ActiveDocument = oldDoc
            Exit For
        End If
    End If
Next

 If Opened Then
 
  Set acadDoc = acadApp.ActiveDocument
 Else
 Set acadDoc = acadApp.Documents.Open(dwgFile)
    'Set acadDoc = acadApp.Documents.Open("D:\Work\xiya\cad.dwg")
 End If



Dim blkInsPnt_1(0 To 2) As Double
blkInsPnt_1(0) = 0: blkInsPnt_1(1) = 0: blkInsPnt_1(2) = 0

myReference_1 = acadDoc.ModelSpace.InsertBlock(blkInsPnt_1, "C:\CAD图纸签名\CAD图纸签名.dwg", 1#, 1#, 1#, 0)
myReference_1.Delete

For Each myObj In acadDoc.ModelSpace
    If myObj.ObjectName = "AcDbBlockReference" Then
        If InStr(myObj.Name, "jk_") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "admin") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "方丁伟") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "李娟") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "李明") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "蔺成丽") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "彭锋") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "祁二骆") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "宋兴健") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "王东雪") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "王志禹") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "吴驾") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "夏春晓") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "杨红日") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "杨磊") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "殷凯斯") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "张文学") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "郑水云") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "朱艾维") <> 0 Then
            myObj.Delete
       End If
    End If
Next


For Each myObj In acadDoc.ModelSpace
    If myObj.ObjectName = "AcDbBlockReference" Then
       If InStr(myObj.Name, "1-标题栏") <> 0 Then
            Attrs = myObj.GetAttributes
            For J = LBound(Attrs) To UBound(Attrs)
                If "批准签名时间" = Attrs(J).TagString Then
                    Attrs(J).TextString = ""
                ElseIf "工艺时间" = Attrs(J).TagString Then
                    Attrs(J).TextString = ""
                ElseIf "审核时间" = Attrs(J).TagString Then
                    Attrs(J).TextString = ""
                ElseIf "标准化时间" = Attrs(J).TagString Then
                    Attrs(J).TextString = ""
                ElseIf "设计时间" = Attrs(J).TagString Then
                    Attrs(J).TextString = ""
                ElseIf "批准时间" = Attrs(J).TagString Then
                    Attrs(J).TextString = ""
                End If
                Attrs(J).Update
            Next
        End If
    End If
Next

 


acadDoc.Save
acadDoc.Close (False)
If Not acadStarted Then
'acadApp.Quit
End If
'FinalRelease
End Sub