关于使用excel的VBA来打印CAD的图纸

雪狼

程序的意义是可以通过EXCEL打开多个CAD文件，并根据图纸中的图框来循环打印PDF。

网上的代码基本运行环境都是在CAD中采用lsp或者VBA实现，但是由于工作环境以及习惯，使用EXCEL的VBA更合适一些，但是代码缺不能实现，
在执行到最后，输出的只是图纸默认的窗口范围。
具体代码如下：

'简单说明一下打印函数
'cadDoc - 打开的cad文件
'kuainame - 打印图框名称
'PrinterName -打印机名称
'Styles -样式表名称
'MediaName -纸张大小
'AutoMedia -自动纸张开关
'AutoRotate -自动旋转, 纵向 / 横向

Function PlotFunction(cadDoc As Object, kuainame As String, PrinterName As String, Styles As String, MediaName As String, AutoMedia As Boolean, AutoRotate As Boolean)

On Error Resume Next

Dim MyAcadApp As Object
Set MyAcadApp = cadDoc.Application
    MyAcadApp.ZoomAll

'打印参数设置

Dim ptMin As Variant, ptMax As Variant

Set objDoc = MyAcadApp.ActiveDocument
  

Set objLayout = objDoc.Layouts.Item("模型") '中文版本，“模型”布局
'Set objLayout = objDoc.Layouts.Item("Model")

' 设置打印机
If Not Trim(PrinterName) = "" Then
objLayout.ConfigName = PrinterName
Else
Exit Function
End If
' 设置打印样式表
If Not Trim(Styles) = "" Then
objLayout.StyleSheet = Styles

Else
objLayout.StyleSheet = "acad.ctb"
End If
' 设置图纸尺寸
If AutoMedia Then
objLayout.CanonicalMediaName = "A4"
Else
If Not Trim(MediaName) = "" Then
objLayout.CanonicalMediaName = MediaName
Else
objLayout.CanonicalMediaName = "A4"
End If
End If
' 设置图纸单位
objLayout.PaperUnits = acMillimeters
' 设置默认图纸打印方向
'objLayout.PlotRotation = ac0degrees '纵向
objLayout.PlotRotation = ac90degrees '横向
' 设置图纸打印比例
objLayout.StandardScale = acScaleToFit
objLayout.UseStandardScale = True '使用标准打印比例
'objLayout.UseStandardScale = False '使用自定义打印比例
' 设置自定义打印比例
'objLayout.SetCustomScale txtNumerator.Value, txtDenominator.Value
' 设置图纸是否居中打印
objLayout.CenterPlot = True
' 打印时使用图形文件中的线宽
objLayout.PlotWithLineweights = True
' 设置是否应用打印样式
objLayout.PlotWithPlotStyles = True
' 打印时隐藏图纸空间对象
objLayout.PlotHidden = False
' 设置图纸打印份数
objDoc.Plot.NumberOfCopies = 1
' 将打印错误报告切换为静默错误模式，以便不间断地执行打印任务
objDoc.Plot.QuietErrorMode = True
' 设置前台打印，使打印任务按打印顺序依次发送到打印机
objDoc.SetVariable "BACKGROUNDPLOT", 0
' 重新生成当前图形
objDoc.Regen acAllViewports
' 根据图块的左下角及右上角坐标设置打印窗口
   
   Dim a As Integer
    a = 0
   For a = 1 To i ’i是选择集获取的图框数量
      
      blockarry(a).blockObj.GetBoundingBox ptMin, ptMax 'blockarry(a)为机构体，元素分别是图框块，以及图框块插入点信息
      Debug.Print blockarry(a).blockObj.Name  ’确认能获取各图框块名称，程序按意图执行
      
      ReDim Preserve ptMin(0 To 1) ' 将三维点转化为二维点坐标
      ReDim Preserve ptMax(0 To 1)
      
      Debug.Print ptMin(0) & "--" & ptMin(1) ’确认能获取各图框块的左下角及右上角坐标，程序按意图执行
      Debug.Print ptMax(0) & "--" & ptMax(1)
      
      
' 设置打印窗口

      objLayout.SetWindowToPlot ptMin, ptMax
     objLayout.GetWindowToPlot ptMin, ptMax
'      Debug.Print ptMin(0) & "--" & ptMin(1) ’确认窗口赋值成功，程序按意图执行
'      Debug.Print ptMax(0) & "--" & ptMax(1)
      
      objLayout.PlotType = acWindow
'      objLayout.PlotType = acExtents

      If Abs(ptMax(0) - ptMin(0)) < Abs(ptMax(1) - ptMin(1)) And AutoRotate Then
'      If AutoMedia Then objLayout.CanonicalMediaName = "A4"
          objLayout.PlotRotation = ac90degrees
      Else
          objLayout.PlotRotation = ac0degrees
      End If
      
'      objDoc.Plot.DisplayPlotPreview acFullPreview ' 完全预览并提示打印
'      objDoc.Plot.SetLayoutsToPlot = objLayout
      
      objDoc.Plot.PlotToDevice    ’不能正确执行，循环打印的都是模型布局中默认的窗口范围，没有变为前面赋值的范围
'      objPlot.PlotToDevice 'objLayout.ConfigName

    Next a
     If Err <> 0 Then
        Err.Clear
    End If
On Error GoTo 0
'Application.ScreenUpdating = True
  
End Function

雪狼

问题已解决