//比较乱,没有系统的整理。
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