求组关于在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
修改后的程序
''Public Const acWindow As Integer = 4
'Public Const acMillimeterAs Integer = 1
'Public Const ac0degreesAs Integer = 0
'Public Const ac90degreesAs Integer = 1
'Public Const acScaleToFiAs Integer = 0
'Public Const acAllViewportsAs Integer = 1
'Public Const acModelSpace As Integer = 1
'简单说明一下打印函数
'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
cadDoc.Application.ZoomAll
Rem 根据图框位置排序后进行打印
Dim sel_block As Object
Set sel_block = add_ss(cadDoc, "sel_block") '调用函数，创建选择集
'根据图块名称多少，调用BuildFilter，构建图元表过滤表达式，指定不同的图元过滤表达式
Dim tknum
If InStr(1, kuainame, ";") Then
matches = Split(kuainame, ";")
tknum = UBound(matches)
Select Case tknum
Case 1
BuildFilter pType1, pData1, -4, "<OR", 2, matches(0), 2, matches(1), -4, "OR>"
Case 2
BuildFilter pType1, pData1, -4, "<OR", 2, matches(0), 2, matches(1), 2, matches(2), -4, "OR>"
Case 3
BuildFilter pType1, pData1, -4, "<OR", 2, matches(0), 2, matches(1), 2, matches(2), 2, matches(3) - 4, "OR>"
End Select
Else
BuildFilter pType1, pData1, 2, kuainame
End If
sel_block.Select acSelectionSetAll, , , pType1, pData1
On Error Resume Next
Dim blockarry() As BlockArray
Dim blocknow As BlockArray
Dim inPt As Variant'获取块的插入位置坐标
Dim iAs Integer
i = 0
For Each t In sel_block
inPt = t.InsertionPoint
With blocknow
Set .blockObj = t
.blockX = inPt(0)
.blockY = inPt(1)
End With
i = i + 1
ReDim Preserve blockarry(1 To i)
With blockarry(i)
Set .blockObj = blocknow.blockObj
.blockX = blocknow.blockX
.blockY = blocknow.blockY
'Debug.Print blockarry(1).blockObj.Name
End With
Call MaopaoBlockArry(blockarry())
Next t
'Dim Ent As Object
'Dim PlotCount As Integer
'Application.ScreenUpdating = False
'打印参数设置
''环境参数设置
' Dim Osmode As Integer
' Osmode = cadDoc.GetVariable("osmode")
' cadDoc.SetVariable "osmode", 0
'
' Dim Blipmode As Integer
' Blipmode = cadDoc.GetVariable("blipmode")
' cadDoc.SetVariable "blipmode", 0
'
' Dim Cmdecho As Integer
' Cmdecho = cadDoc.GetVariable("cmdecho")
' cadDoc.SetVariable "cmdecho", 0
Dim ptMin As Variant, ptMax As Variant
' 检查当时空间是否为模型空间
'If objDoc.ActiveSpace = acPaperSpace Then
' objDoc.MSpace = True
' objDoc.ActiveSpace = acModelSpace
'End If
'Set objLayout = cadDoc.Layouts.Item("模型")
Set objLayout = cadDoc.Layouts.Item("Model") '打印空白的内容
'Set ActiveLayout = cadDoc.Layouts.Item("Model") 'ActiveLayout对应的旋转命令有效
'Set ActiveLayout = objDoc.ModelSpace.Layout
'Set ActiveLayout = cadDoc.Layouts.Item("模型") '使用图纸默认的模型布局，而且后面的选择无效
Set objPlot = cadDoc.Plot
cadDoc.Application.ZoomExtents
'
'
' 设置打印机
If Not Trim(PrinterName) = "" Then
objLayout.ConfigName = PrinterName
'ActiveLayout.ConfigName = PrinterName
Else
Exit Function
End If
' 设置打印样式表
If Not Trim(Styles) = "" Then
objLayout.StyleSheet = Styles
'ActiveLayout.StyleSheet = Styles
Else
objLayout.StyleSheet = "acad.ctb"
'ActiveLayout.StyleSheet = "acad.ctb"
End If
' 设置图纸尺寸
If AutoMedia Then
objLayout.CanonicalMediaName = "A4"
'ActiveLayout.CanonicalMediaName = "A4"
Else
If Not Trim(MediaName) = "" Then
objLayout.CanonicalMediaName = MediaName
'ActiveLayout.CanonicalMediaName = MediaName
Else
objLayout.CanonicalMediaName = "A4"
'ActiveLayout.CanonicalMediaName = "A4"
End If
End If
' 设置图纸单位
objLayout.PaperUnits = acMillimeters
'ActiveLayout.PaperUnits = acMillimeters
' 设置默认图纸打印方向
'objLayout.PlotRotation = ac0degrees '纵向
objLayout.PlotRotation = ac90degrees '横向
'ActiveLayout.PlotRotation = ac90degrees
' 设置图纸打印比例
objLayout.StandardScale = acScaleToFit
'ActiveLayout.StandardScale = acScaleToFit
objLayout.UseStandardScale = True '使用标准打印比例
'ActiveLayout.UseStandardScale = True
'objLayout.UseStandardScale = False '使用自定义打印比例
' 设置自定义打印比例
'objLayout.SetCustomScale txtNumerator.Value, txtDenominator.Value
' 设置图纸是否居中打印
objLayout.CenterPlot = True
'ActiveLayout.CenterPlot = True
' 打印时使用图形文件中的线宽
objLayout.PlotWithLineweights = True
'ActiveLayout.PlotWithLineweights = True
' 设置是否应用打印样式
objLayout.PlotWithPlotStyles = True
'ActiveLayout.PlotWithPlotStyles = True
' 打印时隐藏图纸空间对象
objLayout.PlotHidden = False
'ActiveLayout.PlotHidden = False
' 设置图纸打印份数
objPlot.NumberOfCopies = 1
' 将打印错误报告切换为静默错误模式，以便不间断地执行打印任务
objPlot.QuietErrorMode = True
' 设置前台打印，使打印任务按打印顺序依次发送到打印机
cadDoc.SetVariable "BACKGROUNDPLOT", 0
' 重新生成当前图形
cadDoc.Regen acAllViewports
' 根据图块的左下角及右上角坐标设置打印窗口
Dim a, b, c As Integer
a = 0
' b = 0
' c = 1
For a = 1 To i
blockarry(a).blockObj.GetBoundingBox ptMin, ptMax
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
' ActiveLayout.SetWindowToPlot ptMin, ptMax
' cadDoc.acModelSpace.SetWindowToPlot ptMin, ptMax
objLayout.SetWindowToPlot ptMin, ptMax
' ActiveLayout.SetWindowToPlot ptMin, ptMax
Dim pptMin As Variant, pptMax As Variant
objLayout.GetWindowToPlot pptMin, pptMax
Debug.Print pptMin(0) & "--" & pptMin(1)
Debug.Print pptMax(0) & "--" & pptMax(1)
objLayout.PlotType = acWindow
' ActiveLayout.PlotType = acWindow'起作用会导致选区为空
' objLayout.PlotType = acExtents
If Abs(ptMax(0) - ptMin(0)) < Abs(ptMax(1) - ptMin(1)) And AutoRotate Then '纵图不旋转
objLayout.PlotRotation = ac0degrees
' ActiveLayout.PlotRotation = ac90degrees
Else
objLayout.PlotRotation = ac90degrees '旋转命令无效
' ActiveLayout.PlotRotation = ac0degrees '旋转命令有效
End If
' objDoc.Plot.DisplayPlotPreview acFullPreview ' 完全预览并提示打印
' objDoc.Plot.SetLayoutsToPlot = objLayout
objPlot.PlotToDevice
' objPlot.PlotToDevice 'objLayout.ConfigName
Next a
If Err <> 0 Then
Err.Clear
End If
On Error GoTo 0
'Application.ScreenUpdating = True
End Function
我提供一下我参考的源程序，这个源程序应该是在CAD的VBA环境运行，我取其中一部分并做了修改
'快速打印/批量打印
Public Sub PlotFunction(PrinterName As String, Styles As String, MediaName As String, Copies As Integer, AutoMedia As Boolean, AutoRotate As Boolean, AutoClose As Boolean, AutoFrame As Boolean)
On Error Resume Next
Dim ptMin As Variant, ptMax As Variant
Dim Ent As AcadEntity
Dim PlotCount As Integer
Set objDoc = ThisDrawing.Application.ActiveDocument
Set objLayout = objDoc.Layouts.Item("Model")
Set objPlot = objDoc.Plot
ThisDrawing.Application.ZoomExtents
' 设置打印机
If Not Trim(PrinterName) = "" Then
objLayout.ConfigName = PrinterName
Else
Exit Sub
End If
' 设置打印样式表
If Not Trim(Styles) = "" Then
objLayout.StyleSheet = Styles
Else
objLayout.StyleSheet = "acad.ctb"
End If
' 设置图纸尺寸
If AutoMedia Then
objLayout.CanonicalMediaName = "A3"
Else
If Not Trim(MediaName) = "" Then
objLayout.CanonicalMediaName = MediaName
Else
objLayout.CanonicalMediaName = "A3"
End If
End If
' 设置图纸单位
objLayout.PaperUnits = acMillimeters
'objLayout.PaperUnits = acInches
' 设置默认图纸打印方向
'objLayout.PlotRotation = ac0degrees '纵向
'objLayout.PlotRotation = ac180degrees
objLayout.PlotRotation = ac90degrees '横向
'objLayout.PlotRotation = ac270degrees
' 设置图纸打印比例
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
' 设置图纸打印份数
If Copies >= 1 Then
objPlot.NumberOfCopies = CInt(Copies)
Else
objPlot.NumberOfCopies = 1
End If
' 将打印错误报告切换为静默错误模式，以便不间断地执行打印任务
objPlot.QuietErrorMode = True
' 重新生成当前图形
objDoc.Regen acAllViewports
' 设置前台打印，使打印任务按打印顺序依次发送到打印机
objDoc.SetVariable "BACKGROUNDPLOT", 0
PlotCount = 0 '打印计数
For Each Ent In objDoc.ModelSpace
If TypeOf Ent Is AcadBlockReference Then
If IsFrame(Ent, AutoFrame) = True And objDoc.Blocks(Ent.Name).count > 0 Then Ent.GetBoundingBox ptMin, ptMax
Debug.Print Ent.Name & "--" & objDoc.Blocks(Ent.Name).count
' 将三维点转化为二维点坐标
ReDim Preserve ptMin(0 To 1)
ReDim Preserve ptMax(0 To 1)
' 设置打印窗口
ThisDrawing.ActiveLayout.SetWindowToPlot ptMin, ptMax
objLayout.PlotType = acWindow
If Abs(ptMax(0) - ptMin(0)) < Abs(ptMax(1) - ptMin(1)) Then
If AutoMedia Then objLayout.CanonicalMediaName = "A4"
If AutoRotate Then objLayout.PlotRotation = ac0degrees
End If
' 完全预览并提示打印
objPlot.DisplayPlotPreview acFullPreview
UserSel = MsgBox("是否打印预览？" & Chr(13) & Chr(13) & "打印到：" & objLayout.ConfigName & " 大小：" & objLayout.CanonicalMediaName & " 方式：acWindow(" & objLayout.PlotType & ") " & Chr(13) & Chr(13) & "选择[取消]退出程序！", vbYesNoCancel, "打印选项")
If UserSel = vbYes Then
objPlot.PlotToDevice objLayout.ConfigName
PlotCount = PlotCount + 1
ElseIf UserSel = vbCancel Then
Exit For
End If
End If
End If
Next Ent
' 图框为编组(Group)对象时
Dim FrmGrp As AcadGroup
Dim TptMin, TptMax As Variant
' 按编组名称查找图框编组对象
For Each FrmGrp In ThisDrawing.Groups
If IsFrame(FrmGrp, False) And FrmGrp.count > 0 Then
Debug.Print FrmGrp.Name & " :" & FrmGrp.count & "----group"
' 得到图框边界点坐标
FrmGrp.Item(0).GetBoundingBox ptMin, ptMax
For i = 1 To FrmGrp.count - 1
FrmGrp.Item(i).GetBoundingBox TptMin, TptMax
ReDim Preserve TptMin(0 To 1)
ReDim Preserve TptMax(0 To 1)
For j = 0 To 1
If TptMin(j) < ptMin(j) Then
ptMin(j) = TptMin(j)
End If
If TptMax(j) > ptMax(j) Then
ptMax(j) = TptMax(j)
End If
Next j
i = i + 1
Next
' 将三维点转化为二维点坐标
ReDim Preserve ptMin(0 To 1)
ReDim Preserve ptMax(0 To 1)
' 设置打印窗口
ThisDrawing.ActiveLayout.SetWindowToPlot ptMin, ptMax
objLayout.PlotType = acWindow
If Abs(ptMax(0) - ptMin(0)) < Abs(ptMax(1) - ptMin(1)) Then
If AutoMedia Then objLayout.CanonicalMediaName = "A4"
If AutoRotate Then objLayout.PlotRotation = ac0degrees
End If
' 完全预览并提示打印
objPlot.DisplayPlotPreview acFullPreview
UserSel = MsgBox("是否打印预览？" & Chr(13) & Chr(13) & "打印到：" & objLayout.ConfigName & " 大小：" & objLayout.CanonicalMediaName & " 方式：acWindow(" & objLayout.PlotType & ") " & Chr(13) & Chr(13) & "选择[取消]退出程序！", vbYesNoCancel, "打印选项")
If UserSel = vbYes Then
PlotCount = PlotCount + 1
objPlot.PlotToDevice objLayout.ConfigName
ElseIf UserSel = vbCancel Then
Exit For
End If
End If
Next FrmGrp
' 没有找到图框时按范围打印
If PlotCount = 0 And objDoc.ModelSpace.count > 0 Then
ptMax = ThisDrawing.GetVariable("EXTMAX")
ptMin = ThisDrawing.GetVariable("EXTMIN")
' 图形范围内无实体则退出
If ptMax(0) = ptMin(0) Or ptMax(1) = ptMin(1) Then
Exit Sub
End If
' 设置范围打印
objLayout.PlotType = acExtents
' 对纵向的图纸设置
If Abs(ptMax(0) - ptMin(0)) < Abs(ptMax(1) - ptMin(1)) Then
If AutoMedia Then objLayout.CanonicalMediaName = "A4"
If AutoRotate Then objLayout.PlotRotation = ac0degrees
End If
' 完全预览并提示打印
objPlot.DisplayPlotPreview acFullPreview
UserSel = MsgBox("是否打印预览？" & Chr(13) & Chr(13) & "打印到：" & objLayout.ConfigName & " 大小：" & objLayout.CanonicalMediaName & " 方式：acExtents(" & objLayout.PlotType & ") " & Chr(13) & Chr(13) & "选择[取消]退出程序！", vbYesNoCancel, "打印选项")
If UserSel = vbYes Then
objPlot.PlotToDevice objLayout.ConfigName
ElseIf UserSel = vbCancel Then
Exit Sub
End If
End If
' 关闭文档False 为不保存修改
If AutoClose Then objDoc.Close False, ThisDrawing.Name
End Sub
Public Function IsFrame(entobj As Object, AutoMode As Boolean) As Boolean '判断是否为图框
On Error Resume Next
IsFrame = False
Dim i As Integer
Dim FrmNameList As Variant
FrmNameList = "blkFrame,A1,A2,A3,A4,PC_PAPER_DIC" '图框块、编组名列表FrmNameList = Split(FrmNameList, ",")
For i = 0 To UBound(FrmNameList)
If entobj.Name = FrmNameList(i) Then
IsFrame = True
Exit For
End If
Next
'块名不符时由大小比例判断是否为图框(可能会误判,不过几率不高)
If IsFrame = False And AutoMode And entobj.ObjectName = "AcDbBlockReference" Then entobj.GetBoundingBox ptMin, ptMax
Debug.Print ptMin(0) & "--" & ptMax(0)
If Abs((ptMax(1) - ptMin(1)) / (ptMax(0) - ptMin(0)) - 1.414) < 0.01 Or Abs((ptMax(1) - ptMin(1)) / (ptMax(0) - ptMin(0)) - 0.707) < 0.01 Then
IsFrame = True
End If
End If
End Function
数据分析的情况：
比例是一致的，1：1，只是原点不一致，具体如下：
X坐标 Y坐标 长（X2-X1） 高（Y2-Y1） 原点差值（XB-XP） 原点差值（YB-YP）
第一个图框块GetBoundingBox获得的坐标 左下角 803290 541273 29404 20439 149269 180006
右上角 832694 561713
第一个图框块为打印窗口后GetWindowToPlot获取坐标 左下角 654021 361267 29404 20439
右上角 683425 381707
第二个图框块GetBoundingBox获得的坐标 左下角 832694 541273 29404 20439 149269 180006
右上角 862098 561713
第二个图框块为打印窗口后GetWindowToPlot获取坐标 左下角 683425 361267 29485 20439
右上角 712910 381707
第三个图框块GetBoundingBox获得的坐标 左下角 862096 541273 29409 42302 149269 180005
右上角 891504 583575
第三个图框块为打印窗口后GetWindowToPlot获取坐标 左下角 712827 361269 29660 42299
右上角 742487 403568
第四个图框块GetBoundingBox获得的坐标 左下角 803290 494623 29404 20439 149269 180006
右上角 832694 515062
第四个图框块为打印窗口后GetWindowToPlot获取坐标 左下角 654021 314617 29406 20439
右上角 683428 335056
第五个图框块GetBoundingBox获得的坐标 左下角 832692 494623 29409 42302 149269 180005
右上角 862100 536925
第五个图框块为打印窗口后GetWindowToPlot获取坐标 左下角 683423 314618 29409 42299
右上角 712832 356917
Set objLayout = objDoc.Layouts.Item("模型") '中文版本，“模型”布局
'Set objLayout = objDoc.Layouts.Item("Model")
这2句估计有点问题，图纸布局空间可以用上2句方式，模型空间不同于图纸空间的，按下边这么写试试吧。
Set objLayout = objDoc.ModelSpace.Layout 感谢建议，不过还是不行 ReDim Preserve ptMin(0 To 1)
你确定需要转换么？模型是三维的。原始程序是不是用在layout上的？ 打印应该是二维的吧，可以测试一下，感谢提供解决思路 blockarry(a).blockObj.GetBoundingBox ptMin, ptMax
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
' ActiveLayout.SetWindowToPlot ptMin, ptMax
' cadDoc.acModelSpace.SetWindowToPlot ptMin, ptMax
objLayout.SetWindowToPlot ptMin, ptMax
' ActiveLayout.SetWindowToPlot ptMin, ptMax
Dim pptMin As Variant, pptMax As Variant
objLayout.GetWindowToPlot pptMin, pptMax
Debug.Print pptMin(0) & "--" & pptMin(1)
Debug.Print pptMax(0) & "--" & pptMax(1)
以上部分代码的执行结果：
a4h
803289.999954268--541273.365925417
832693.999954268--561712.731753247
654021.295610093--361267.136916942
683425.295610093--381706.502744772
a4h
832693.999954268--541273.365925417
862097.999954267--561712.731753247
654021.295610093--361267.136916942
683425.295610093--381706.502744772
a4z
862095.684084867--541273.365925417
891504.315823679--583575.467145161
654021.295610093--361267.136916942
683425.295610093--381706.502744772
a4h
803289.999954268--494623.000097587
832693.999954268--515062.365925417
654021.295610093--361267.136916942
683425.295610093--381706.502744772
a4z
832691.684084867--494623.000097587
862100.315823679--536925.101317331
654021.295610093--361267.136916942
683425.295610093--381706.502744772
可以看出，objLayout.SetWindowToPlot ptMin, ptMax，并没有起到认为的作用 将上面的三维转二维注释去掉后，执行情况为：
a4h
803289.999954268--541273.365925417
832693.999954268--561712.731753247
803289.999954268--541273.365925417
832693.999954268--561712.731753247
a4h
832693.999954268--541273.365925417
862097.999954267--561712.731753247
832693.999954268--541273.365925417
862097.999954267--561712.731753247
a4z
862095.684084867--541273.365925417
891504.315823679--583575.467145161
862095.684084867--541273.365925417
891504.315823679--583575.467145161
a4h
803289.999954268--494623.000097587
832693.999954268--515062.365925417
803289.999954268--494623.000097587
832693.999954268--515062.365925417
a4z
832691.684084867--494623.000097587
862100.315823679--536925.101317331
832691.684084867--494623.000097587
862100.315823679--536925.101317331
只是打印内容为空白，但是之前打印的是图纸文件上一次模型布局中选定的窗口范围
就是说 窗口的范围设定起作用了，但是为什么打印结果确实空白，是范围有问题，还是其他原因，例如颜色，或者其他 我大概找到原因了，程序执行是正确的，错误的是块的左下角坐标和右上角坐标，不是模型空间的坐标，这是怎么回事，谁清楚啊？
这是块边界左下角坐标：
803289.999954268--541273.365925417
832693.999954268--561712.731753247
同一个块，模型空间打印窗口的数据坐标：
654021.295610093--361267.136916942
683425.295610093--381706.502744772
这是怎么回事啊
页:
[1]
2