【利用VBA批量处理中望CAD的修改打印出PDF】

直接贴程序，没套路

Sub FindAllFile()
    Dim filename  As Variant
    Dim index As Integer
    fpath = "D:\Users\Desktop\"
    filename = Dir(fpath)
    Do While filename <> ""
        If Right(filename, 3) = "dwg" Then
            BlockUpdate fpath + filename, filename
            Debug.Print (filename + " Changed OK")
            index = index + 1
        End If
        filename = Dir
    Loop
    MsgBox ("已经完成修改" & index & "份")
End Sub
Sub BlockUpdate(fpath As String, filename As Variant)
    Dim ModelSpace As ZcadModelSpace
    Dim Blocks As ZcadBlocks
    Dim blkref As Variant
    Dim index, i, attindex As Integer
    Dim varAttributes  As Variant
    Dim frame As String
    ThisDrawing.Application.Documents.Open (fpath)
    Set ModelSpace = ThisDrawing.ModelSpace
    Set Blocks = ThisDrawing.Blocks
    For index = 0 To Blocks.Count - 1
        If Blocks.Item(index).Name = "BTL1" Then
            For i = 0 To Blocks.Item(index).Count - 1
                If TypeOf Blocks.Item(index).Item(i) Is ZcadText Then
                    If Blocks.Item(index).Item(i).TextString = "用户代号" Then
                        Blocks.Item(index).Item(i).TextString = "用户编码"
                    ElseIf Blocks.Item(index).Item(i).TextString = "CLIENT DRAWING NO." Then
                        Blocks.Item(index).Item(i).TextString = "USER CODE NO."
                    End If
                End If
            Next
         ElseIf Blocks.Item(index).Name = "SBWL_A4V" Then
            frame = "SBWL_A4V"
         ElseIf Blocks.Item(index).Name = "SBWL_A3H" Then
            frame = "SBWL_A3H"
         ElseIf Blocks.Item(index).Name = "SBWL_A2H" Then
            frame = "SBWL_A2H"
         ElseIf Blocks.Item(index).Name = "SBWL_A1H" Then
            frame = "SBWL_A1H"
         ElseIf Blocks.Item(index).Name = "SBWL_A0H" Then
            frame = "SBWL_A0H"
         End If
         
    Next
    For index = 0 To ModelSpace.Count - 1
        If TypeOf ModelSpace.Item(index) Is ZcadBlockReference Then
            If ModelSpace.Item(index).EffectiveName = "BTL1" Then
                Set blkref = ModelSpace.Item(index)
                varAttributes = blkref.GetAttributes
                For i = LBound(varAttributes) To UBound(varAttributes)
                    If varAttributes(i).TagString = "CLIENT_DWG{8}" Then
                        varAttributes(i).TextString = "XP-2-PRXJ-44-AA000001-DG-0001"
                    ElseIf varAttributes(i).TagString = "DWG_STATUS{7}" Then
                        varAttributes(i).TextString = "PRE"
                    End If
                Next
            End If
        End If
    Next
    
    ThisDrawing.Save
    PrintPDF filename, frame
    ThisDrawing.Save
    ThisDrawing.Application.Documents.Close
End Sub

Sub PrintPDF(file As Variant, frame As String)
    Dim currentplot As ZcadPlot
    Set currentplot = ThisDrawing.Plot
    file = Replace(file, ".dwg", ".PDF")
    file = GetIndex(file)
    ThisDrawing.ModelSpace.Layout.ConfigName = "DWG TO PDF.pc5"
    ThisDrawing.ModelSpace.Layout.PlotRotation = zc180degrees
    If frame = "SBWL_A4V" Then
        ThisDrawing.ModelSpace.Layout.CanonicalMediaName = "ISO_A4_(210.00_x_297.00_MM)"
    ElseIf frame = "SBWL_A3H" Then
        ThisDrawing.ModelSpace.Layout.CanonicalMediaName = "ISO_A3_(420.00_x_297.00_MM)"
    ElseIf frame = "SBWL_A2H" Then
        ThisDrawing.ModelSpace.Layout.CanonicalMediaName = "ISO_A2_(594.00_x_420.00_MM)"
    Else
        ThisDrawing.ModelSpace.Layout.CanonicalMediaName = "ISO_A1_(841.00_x_594.00_MM)"
    End If
    ThisDrawing.ModelSpace.Layout.CenterPlot = True
    ThisDrawing.ModelSpace.Layout.PlotType = zcExtents
    ThisDrawing.ModelSpace.Layout.StyleSheet = "PCCAD.ctb"
    ThisDrawing.Application.ZoomExtents
    currentplot.PlotToFile ("D:\Users\Desktop\" & file)
End Sub


Function GetIndex(str As Variant) As String
    Dim i, cnt, S, L As Integer
    cnt = 0
    For i = 1 To Len(str)
        If Mid(str, i, 1) = "-" Then
            cnt = cnt + 1
            If cnt = 4 Then
                S = i
                Exit For
            End If
            
        End If
    Next
    If cnt = 4 Then
        L = InStr(str, ".")
        GetIndex = Mid(str, 1, S - 1) + Mid(str, L)
    Else
        GetIndex = str
    End If
End Function