[VBA] 请教如何使用VBA实现分页打印

LucasLynn

我是一个AutoCAD的新手，最近在工作中需要打印一些图纸，因为图纸非常大，需要分成很多页打印，但是怎么都找不到分页打印的功能，后来查了很多资料才知道AutoCAD没这个功能，后来在网上查到有个AutoLisp写的AutoCAD 14的分页打印程序，但是在我的AutoCAD 16中无法使用。所以准备自己手写一个。看了文档以后知道AutoCAD支持Lisp和VBA两种方式的编程，因为我本人有较长时间的Office VBA开发经验，因此选择了VBA。


我的想法是截获应用程序的BeginPlot事件，然后弹出用户窗体以选择横向分页和纵向分页数量，根据数量均分打印区域，分页调用Plot方法。


现在用户窗体已经画完，事件也截获了，但是我发现事件传递的参数少得可怜，不知道如何更改打印区域，另外还需要取消原本的打印任务，因此向各位高手请教。

雪山飞狐_lzh

不用截获事件，你可以做一个单独的宏来处理

LucasLynn

lzh741206发表于2005-6-29 9:32:00不用截获事件，你可以做一个单独的宏来处理

谢谢指点！ 如果单独做一个宏来处理，我该如何获取打印区域的参数呢？另外如何把他加入系统菜单？因为公司很多非程序员都要用到这个，我希望能够给他们提供一个便于操作的界面。现在让我头疼的是以下几个问题： 1、Plot过程中，打印区域的参数是如何获取和设定的。 2、如何将做好的宏加入系统菜单。 还望指点，谢谢！

jsyang_ren

１．如果你是批量打印的话，要获取打印区域有些困难必须要求图纸幅面有一定的规律或者规格，如果是一张图的话ＥＸＴＥＮＤ方式就可以了


２．宏加入系统菜单可以做一些按纽，启动时自动加载就可以了，也可以用ＬＩＳＰ调用，我觉得用ＬＩＳＰ方便些

LucasLynn

jsyang_ren发表于2005-6-29 11:36:00１．如果你是批量打印的话，要获取打印区域有些困难必须要求图纸幅面有一定的规律或者规格，如果是一张图的话ＥＸＴＥＮＤ方式就可以了 ２．宏加入系统菜单可...

我不是批量打印，只是需要分页打印一张较大的图纸，比方说把一张图纸分成3×3张A4纸来打印。请问Extend方式如何使用？

LucasLynn

Public Sub PlotPaging()
Dim point1 As Variant, point2 As Variant
Dim vpoint1 As Variant, vpoint2 As Variant

point1 = ThisDrawing.Utility.GetPoint(, "请点击打印区域的左下角：")
vpoint1 = point1
ReDim Preserve point1(0 To 1)
ReDim Preserve vpoint1(0 To 1)

point2 = ThisDrawing.Utility.GetPoint(, "请点击打印区域的右上角：")
vpoint2 = point2
ReDim Preserve point2(0 To 1)
ReDim Preserve vpoint2(0 To 1)

pagesX = ThisDrawing.Utility.GetInteger("请输入横向分页数：")
pagesY = ThisDrawing.Utility.GetInteger("请输入纵向分页数：")

bolConfirm = MsgBox("你是否确定分页打印以下区域：" & vbCrLf & vbCrLf & _
"左下角：X=" & CStr(CLng(point1(0))) & "，Y=" & CStr(CLng(point1(1))) & vbCrLf & _
"右上角：X=" & CStr(CLng(point2(0))) & "，Y=" & CStr(CLng(point2(1))) & vbCrLf & _
"横向分 " & pagesX & " 页；纵向分 " & pagesY & " 页。", vbOKCancel)

If bolConfirm = vbOK Then
lenX = (point2(0) - point1(0)) / pagesX
lenY = (point2(1) - point1(1)) / pagesY

Dim bolNextPage As Integer

For X = 1 To pagesX
For Y = 1 To pagesY
vpoint1(0) = point1(0) + lenX * (X - 1)
vpoint1(1) = point1(1) + lenY * (Y - 1)
vpoint2(0) = vpoint1(0) + lenX
vpoint2(1) = vpoint1(1) + lenY

ThisDrawing.ActiveLayout.SetWindowToPlot vpoint1, vpoint2

ThisDrawing.ActiveLayout.GetWindowToPlot vpoint1, vpoint2

ThisDrawing.ActiveLayout.PlotType = acWindow

ThisDrawing.Plot.PlotToDevice

bolNextPage = MsgBox("本页打印完成后请按确定，中断打印按取消。", vbOKCancel)

If bolNextPage = vbCancel Then
Exit For
End If
Next Y

If bolNextPage = vbCancel Then
Exit For
End If
Next X
End If
End Sub

LucasLynn

我现在勉强写了个能用的，菜单项通过ACADPopupMenu添加上去了，但是遇到几个问题：


1、同样打印一个区域，为什么直接用Plot打印的速度比我用SetWindowToPlot要快很多倍。


2、分页打印的时候如果一页还没打印完，就执行PlotToDevice，会出现错误，所以我只能增加了一个确认对话框，用起来实在很不方便。但是Plot好像就没这个问题。


请各位高手指点。

LucasLynn

终于搞明白了，原来代码级的Plot调用默认使用后台打印，又慢，又独占了设备，先设置系统变量BACKGROUNDPLOT=0后，一切正常。


谢谢各位高手指点！


顺便问一句，如果我想通过截获系统的PLOT事件，该怎么做呢。

LucasLynn

附上完成后的代码，或许以后哪位朋友能用到。 模块名：acad.dvb!Startup Public Sub PlotPaging()
Dim point1 As Variant, point2 As Variant
Dim vpoint1 As Variant, vpoint2 As Variant

On Error GoTo ErrorHandler_Cancel point1 = ThisDrawing.Utility.GetPoint(, vbLf & "请点击打印区域的左下角：")
vpoint1 = point1
ReDim Preserve point1(0 To 1)
ReDim Preserve vpoint1(0 To 1)

point2 = ThisDrawing.Utility.GetPoint(, "请点击打印区域的右上角：")
vpoint2 = point2
ReDim Preserve point2(0 To 1)
ReDim Preserve vpoint2(0 To 1)

pagesX = ThisDrawing.Utility.GetInteger("请输入横向分页数：")
pagesY = ThisDrawing.Utility.GetInteger("请输入纵向分页数：")
pagesEdge = ThisDrawing.Utility.GetInteger("请输入页边缘扩展百分比（0－100）：")

bolConfirm = MsgBox("你是否确定分页打印以下区域：" & vbCrLf & vbCrLf & _
"左下角：X=" & CStr(CLng(point1(0))) & "，Y=" & CStr(CLng(point1(1))) & vbCrLf & _
"右上角：X=" & CStr(CLng(point2(0))) & "，Y=" & CStr(CLng(point2(1))) & vbCrLf & _
"横向分 " & pagesX & " 页；纵向分 " & pagesY & " 页。" & vbCrLf & _
"页边缘扩展 " & pagesEdge & "%", vbOKCancel)

If bolConfirm = vbOK Then
BACKGROUNDPLOT = ThisDrawing.GetVariable("BACKGROUNDPLOT")
ThisDrawing.SetVariable "BACKGROUNDPLOT", 0

lenX = (point2(0) - point1(0)) / pagesX
lenY = (point2(1) - point1(1)) / pagesY

Dim bolNextPage As Integer

For X = 1 To pagesX
For Y = 1 To pagesY
vpoint1(0) = point1(0) + lenX * (X - 1)
vpoint1(1) = point1(1) + lenY * (Y - 1)
vpoint2(0) = vpoint1(0) + lenX * (pagesEdge / 100 + 1)
vpoint2(1) = vpoint1(1) + lenY * (pagesEdge / 100 + 1)

ThisDrawing.ActiveLayout.SetWindowToPlot vpoint1, vpoint2

ThisDrawing.ActiveLayout.GetWindowToPlot vpoint1, vpoint2

ThisDrawing.ActiveLayout.PlotType = acWindow

ThisDrawing.Plot.PlotToDevice
Next Y

If bolNextPage = vbCancel Then
Exit For
End If
Next X

ThisDrawing.SetVariable "BACKGROUNDPLOT", BACKGROUNDPLOT
End If

ErrorHandler_Cancel: End Sub Sub MenuExtend()
Dim currMenuGroup As AcadMenuGroup
For Each currMenuGroup In ACAD.Application.MenuGroups
If currMenuGroup.Name = "ACAD" Then
Exit For
End If
Next

Dim currMenu As AcadPopupMenu
Dim newMenuItem As AcadPopupMenuItem

For Each currMenu In currMenuGroup.Menus
If currMenu.Name = "文件(&F)" Then
Set newMenuItem = currMenu.AddMenuItem(19, "分页打印", "-VBARUN acad.dvb!Startup.PlotPaging" & Chr(32))
End If
Next
End Sub

wyj7485

用AcadDocument_BeginCommand事件