VB操作cad文件

//比较乱，没有系统的整理。

Module Module1
    Public acadApp As Autodesk.AutoCAD.Interop.AcadApplication
    Public successTempFilePath = "c:\\GASignSuccess.log"
    Public isOpenTempFilePath = "c:\\isAutocadOpen.log"
    Public autocadObjectString = "AutoCAD.Application.17"

    Sub Main()
        Dim arguments() As String
        Dim I As Integer
        Dim flag As String
        Dim param As String

        '1###
        '2###dwgFilePath$$$context$$$isfirst
        arguments = Split(Command$, "###")
        For I = LBound(arguments) To UBound(arguments)
            Select Case I
                Case 0
                    flag = arguments(I)
                    System.Console.WriteLine("flag:" + flag)
                Case 1
                    param = arguments(I)
                    If (flag = "1") Then
                        quitAutoCad()
                    Else
                        If (flag = "2") Then
                            System.Console.WriteLine("param:" + param)
                            GASign(param)
                        End If
                    End If
            End Select
        Next
    End Sub

    Sub GASign(ByVal Args As String)
        Dim acadDoc As Autodesk.AutoCAD.Interop.AcadDocument
        Dim arguments() As String
        Dim dwgFilePath As String
        Dim I As Integer
        Dim user As String
        Dim time As String
        Dim isFirst As String

        arguments = Split(Args, "$$$")
        For I = LBound(arguments) To UBound(arguments)
            Select Case I
                Case 0
                    dwgFilePath = arguments(I)
                    System.Console.WriteLine("dwgFilePath:" + dwgFilePath)
                Case 1
                    user = arguments(I)
                    'context = context & vbCrLf & "kkkkk"
                    System.Console.WriteLine("user:" + user)
                Case 2
                    time = arguments(I)
                    System.Console.WriteLine("time:" + time)
                Case 3
                    isFirst = arguments(I)
                    System.Console.WriteLine("isFirst:" + isFirst)
            End Select
        Next

        WriteInfo(successTempFilePath, "")
        WriteInfo(isOpenTempFilePath, "")

        Try
            acadApp = GetObject(, autocadObjectString)
        Catch ex As Exception
            WriteInfo(successTempFilePath, "GetObject Exception:" + ex.Message)
            System.Console.WriteLine("GetObject Exception:" + ex.Message)
        End Try

        If (acadApp Is Nothing) Then
            Try
                acadApp = CreateObject(autocadObjectString)
            Catch ex As Exception
                WriteInfo(successTempFilePath, "CreateObject Exception:" + ex.Message)
                System.Console.WriteLine("CreateObject Exception:" + ex.Message)
            End Try
        Else
            If (isFirst = "true") Then
                WriteInfo(isOpenTempFilePath, "yes")
            End If
        End If

        If (acadApp Is Nothing) Then
            Return
        Else

            If (dwgFilePath.Length > 0) Then
                Try
                    If (IO.File.Exists(dwgFilePath)) Then
                        acadDoc = acadApp.Documents.Open(dwgFilePath)
                    Else
                        WriteInfo(successTempFilePath, "File Exception:文件不存在")
                        Return
                    End If
                Catch ex As Exception
                    WriteInfo(successTempFilePath, "Open Exception" + ex.Message)
                    System.Console.WriteLine("Open Exception:" + ex.Message)
                    ' MsgBox(Err.Description)
                End Try
            End If
        End If

        If (acadDoc Is Nothing) Then
            Return
        Else

            Dim Attrs As Object
            Dim myModelSpace As Autodesk.AutoCAD.Interop.Common.AcadObject
            Dim J As Integer
            Dim modelName As String
            Dim modelObjectName As String
            Dim attributeObj As Autodesk.AutoCAD.Interop.Common.AcadAttribute

            For Each myModelSpace In acadDoc.ModelSpace
                Try
                    modelObjectName = myModelSpace.ObjectName
                Catch ex As Exception
                    'System.Console.WriteLine("ObjectName Exception:" + ex.Message)
                End Try
                If modelObjectName = "AcDbBlockReference" Then
                    Try
                        modelName = myModelSpace.name
                    Catch ex As Exception
                        'System.Console.WriteLine("name Exception:" + ex.Message)
                    End Try
                    If modelName = "PC_TITLE_BLOCK" Then
                        Try
                            Attrs = myModelSpace.GetAttributes
                            For J = LBound(Attrs) To UBound(Attrs)
                                If (Attrs(J).TagString = "批准") Then
                                    System.Console.WriteLine("user context:" + user)
                                    Attrs(J).TextString = user
                                    WriteInfo(successTempFilePath, "ok")
                                Else
                                    If (Attrs(J).TagString = "批准日期") Then
                                        System.Console.WriteLine("time context:" + time)

                                        ' Attrs(J).FieldLength = 0.3
                                        Try
                                            'attributeObj = Attrs(J)
                                            'MsgBox("The FieldLength of the attribute is " & Attrs(J).ScaleFactor, vbInformation, "FieldLength 示例")

                                            ' Dim currFieldLength As Integer
                                            ' currFieldLength = Attrs(J).FieldLength
                                            'Attrs(J).FieldLength = currFieldLength + 1

                                            '有效的控制字的大小：ScaleFactor和Height
                                            ' Attrs(J).ScaleFactor = 0.3  指定文字的缩放比例。

                                            '通过可以控制字的高度，字变小变大
                                            ' Attrs(J).Height = 4  ' 属性的高度

                                            '通过.....
                                            ' Define the scale
                                            ' Dim basePoint(0 To 2) As Double
                                            'Dim scalefactor As Double
                                            'basePoint(0) = 2 : basePoint(1) = 2.25 : basePoint(2) = 0
                                            'scalefactor = 0.9
                                            ' Scale the polyline
                                            ' Attrs(J).ScaleEntity(basePoint, scalefactor)

 

                                            Dim currentThickness As Double
                                            currentThickness = Attrs(J).thickness
                                            MsgBox("The currentThickness of the attribute is " & Attrs(J).thickness, vbInformation, "currentThickness 示例")

                                            Attrs(J).thickness = currentThickness - 30

                                            Attrs(J).TextString = getTime(time)
                                            System.Console.WriteLine("time context2:" + getTime(time))
                                            Attrs(J).Visible = True

                                            Attrs(J).Update()

                                        Catch ex As Exception
                                            System.Console.WriteLine("FieldLength Exception:" + ex.Message)
                                        End Try

                                        WriteInfo(successTempFilePath, "ok")
                                    End If
                                End If
                            Next
                        Catch ex As Exception
                            ' System.Console.WriteLine("GetAttributes Exception:" + ex.Message)
                        End Try
                    End If
                End If
            Next
        End If

        Try
            acadDoc.Close()
        Catch ex As Exception
            System.Console.WriteLine("Close Exception:" + ex.Message)
        End Try
    End Sub

    Sub quitAutoCad()
        Try
            acadApp = GetObject(, autocadObjectString)
        Catch ex As Exception
            WriteInfo(successTempFilePath, "quitAutoCad:GetObject Exception:" + ex.Message)
            System.Console.WriteLine("quitAutoCad:GetObject Exception:" + ex.Message)
        End Try
        If (acadApp Is Nothing) Then
        Else
            Try
                If (IO.File.Exists(isOpenTempFilePath)) Then
                    Dim Line As String
                    For Each Line In IO.File.ReadAllLines(isOpenTempFilePath)
                        System.Console.WriteLine("Line:" + Line)
                        If (Line = "yes") Then
                            Return
                        End If
                    Next
                    '  DeleteFile(isOpenTempFilePath)
                End If
            Catch ex As Exception
                System.Console.WriteLine("File Exception:" + ex.Message)
            End Try
            Try
                acadApp.Quit()
            Catch ex As Exception
                System.Console.WriteLine("Quit Exception:" + ex.Message)
            End Try
        End If
    End Sub

    Function WriteInfo(ByVal filePath As String, ByVal context As String)
        Dim fileStream As IO.FileStream
        If (IO.File.Exists(filePath)) Then
            Try
                IO.File.WriteAllText(filePath, context)
                WriteInfo = True
            Catch ex As Exception
                WriteInfo = False
                System.Console.WriteLine("WriteAllText Exception:" + ex.Message)
            End Try
        Else
            Try
                fileStream = IO.File.Create(filePath)
                IO.File.WriteAllText(filePath, context)
                WriteInfo = True
                fileStream.Close()
            Catch ex As Exception
                WriteInfo = False
                System.Console.WriteLine("Create and WriteAllText Exception:" + ex.Message)
            End Try
        End If
    End Function

    Function DeleteFile(ByVal filePath As String)
        Try
            If (IO.File.Exists(filePath)) Then
                IO.File.Delete(filePath)
                DeleteFile = True
            Else
                DeleteFile = True
            End If
        Catch ex As Exception
            DeleteFile = False
            System.Console.WriteLine("Delete Exception:" + ex.Message)
        End Try
    End Function

    Function getTime(ByVal time As String)
        Dim arguments As String()
        Dim I As Integer
        Dim year = ""
        Dim month = ""
        Dim day = ""
        Dim timestr = ""

        Try
            arguments = Split(time, "-")
            For I = LBound(arguments) To UBound(arguments)
                Select Case i
                    Case 2
                        year = arguments(I)

                    Case 0
                        month = arguments(I)
                    Case 1
                        day = arguments(I)

                End Select
            Next
            timestr = year + month + day
            getTime = timestr
        Catch ex As Exception
            getTime = timestr
            System.Console.WriteLine("getTime Exception:" + ex.Message)
        End Try

    End Function
End Module