LBdianziqianming/cadVb/code/vbproject_jk/clear20181123/Module1.bas

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ͼֽǩ<D6BD><C7A9>\CADͼֽǩ<D6BD><C7A9>.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, "<22><><EFBFBD><EFBFBD>ΰ") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "<22><><EFBFBD><EFBFBD>") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "<22><><EFBFBD><EFBFBD>") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "<22><><EFBFBD><EFBFBD>") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "<22><><EFBFBD>˽<EFBFBD>") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "<22><><EFBFBD><EFBFBD>ѩ") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "<22><>־<EFBFBD><D6BE>") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "<22><><EFBFBD><EFBFBD>") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "<22>Ĵ<EFBFBD><C4B4><EFBFBD>") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "<22><><EFBFBD><EFBFBD>") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "<22><><EFBFBD><EFBFBD>˹") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "<22><><EFBFBD><EFBFBD>ѧ") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "֣ˮ<D6A3><CBAE>") <> 0 Then
            myObj.Delete
        ElseIf InStr(myObj.Name, "<22>찬ά") <> 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-<2D><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>") <> 0 Then
            Attrs = myObj.GetAttributes
            For J = LBound(Attrs) To UBound(Attrs)
                If "<22><>׼ǩ<D7BC><C7A9>ʱ<EFBFBD><CAB1>" = Attrs(J).TagString Then
                    Attrs(J).TextString = ""
                ElseIf "<22><><EFBFBD><EFBFBD>ʱ<EFBFBD><CAB1>" = Attrs(J).TagString Then
                    Attrs(J).TextString = ""
                ElseIf "<22><><EFBFBD><EFBFBD>ʱ<EFBFBD><CAB1>" = Attrs(J).TagString Then
                    Attrs(J).TextString = ""
                ElseIf "<22><>׼<EFBFBD><D7BC>ʱ<EFBFBD><CAB1>" = Attrs(J).TagString Then
                    Attrs(J).TextString = ""
                ElseIf "<22><><EFBFBD><EFBFBD>ʱ<EFBFBD><CAB1>" = Attrs(J).TagString Then
                    Attrs(J).TextString = ""
                ElseIf "<22><>׼ʱ<D7BC><CAB1>" = 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