[原创]VBA版 批量打印更新

lennie

老版本：http://bbs.mjtd.com/forum.php?mod=viewthread&tid=64559&replyID=&skin=1

特点：
1、图名、图号可以自动提取（可以配合编写图纸目录）（图名、图号不是块属性，可以方便地自由编辑）
2、打印队列有顺序（出图有顺序 整理图纸就方便多了）
3、队列中的图纸可以指定不同的打印参数（包括使用不同的打印机、打印式样、纸张等几乎所有的打印参数）
4、配合第3点可以做到不同图幅的图纸用不同的纸张打印（一套图有多种图幅的情况非常普遍），通过简单设定即可一次出图
5、VBA执行速度较快（相对Lisp），出图快

 

新版的改进以及未来的设想：
1、功能更加强大，不同的图纸可以具体指定参数
2、屏幕中选择框选的图框时，图框的图号和图名一定要在屏幕中显示，否则会提取失败（图元多时 ZOOMALL 消耗时间太多，故放弃）
3、界面变化较大，可以设定的参数更多
4、未来争取可以多文档执行（有些院图纸是一个文件一张图的）

xxxtttxxx

让别人看看FLASH有什么意思，更多的信息呢？

程序呢？

其实我自己写的程序在某种规则下面已经实现了对不同尺寸图纸

自动识别的能力。虽然可能并不完善，但是总的来说，还是足够实用的。

xxxtttxxx

在某些情况下，一般都是图纸比较复杂（大）的情况下出现：

就是选择图框打印后，打印区域出现偏移，

或者打印内容只占图纸的一个小角落（已经设置布满图纸），

怀疑是否与坐标系有关，或者图纸版本有关。请教原因。

guoyu450

xxxtttxxx发表于2008-3-4 17:43:00在某些情况下，一般都是图纸比较复杂（大）的情况下出现：就是选择图框打印后，打印区域出现偏移，或者打印内容只占图纸的一个小角落（已经设置布满图纸），怀疑是否与坐标系有关，或者图纸版本

我觉得这个问题的确是CAD自身的问题，但是也只有极个别的DWG文件才会出现这种问题。

问题分析：其实这是CAD锁定打印对角角点错位照成的，换句话说选择的窗口大小还是对的，就是位置偏差了，有些图会差很远。

本人蹩脚的解决方法：参照偏差窗口进行手动X轴Y轴补偿，换句话说就是特意选择与图纸反向偏差相同距离的一个窗口，最后打印窗口就正好是图纸了。

另外，支持楼上的，请楼主透露点源码让我们过过瘾吧。。。

lennie

xxxtttxxx发表于2008-3-4 17:48:00在某些情况下，一般都是图纸比较复杂（大）的情况下出现：就是选择图框打印后，打印区域出现偏移，或者打印内容只占图纸的一个小角落（已经设置布满图纸），怀疑是否与坐标系有关，或者图纸版本

这个问题我倒是没有碰到过。是不是世界坐标、显示坐标的原因。下面的文字是我从网上摘录的。

VBA中GetPoint以及GetBoundingBox返回的是都是世界坐标(WCS),而ThisDrawing.ModelSpac
e.Layout.SetWindowToPlot中使用的却是显示坐标(DCS),
我们可以使用ThisDrawing.Utility.TranslateCoordinates(PtMax, acWorld, acDisplayDC
S, False)将世界坐标转换成显示坐标，这样就不会出现打印的时候图像出现偏移。

Function KSDY(E As AcadEntity)
    E.GetBoundingBox PtMin, PtMax '返回的是世界坐标

    '将世界坐标(WCS)转换为显示坐标(DCS)
    Dim PtMax_UCS As Variant
    Dim PtMin_UCS As Variant
    PtMax_UCS = ThisDrawing.Utility.TranslateCoordinates(PtMax, acWorld, acDisplayDCS, False)
    PtMin_UCS = ThisDrawing.Utility.TranslateCoordinates(PtMin, acWorld, acDisplayDCS, False)
   
   
    ' 将三维点转化为二维点坐标
    ReDim Preserve PtMin_UCS(0 To 1)
    ReDim Preserve PtMax_UCS(0 To 1)
   

    ' 设置打印窗口(为显示坐标DCS)
    ThisDrawing.ModelSpace.Layout.SetWindowToPlot PtMax_UCS, PtMin_UCS
   
   
    If Me.OptionButton4.Value = True Then
        '启用打印预览
        ThisDrawing.ActiveLayout.GetWindowToPlot PtMax_UCS, PtMin_UCS
        ThisDrawing.ActiveLayout.PlotType = acWindow
        ThisDrawing.Plot.DisplayPlotPreview acFullPreview
    Else
        '打印当前的区域
        '若选中“打印到文件”
        If PlotTofile_CheckBox.Value Then
            If PlotFilesPath_ComboBox.Text = "" Then PlotFilesPath_ComboBox.Text = GetPath
            ThisDrawing.Plot.PlotToFile PlotFilesPath_ComboBox.Text & ThisDrawing.Name & "-" & n & ".plt"
            n = n + 1
        Else
            ThisDrawing.Plot.PlotToDevice ThisDrawing.ModelSpace.Layout.ConfigName
        End If
    End If
End Function

xxxtttxxx

出现这个问题的图纸非常奇怪，我把图上所有的东西都删除，但是有

一个图层无法删除，我用vba一段程序把这个图层和图层里面看不到的东西都删除了。

然后我再保存为R12，把$paperspace,和$modelspace都删除了,保存为R12

然后用cad2006打开，随便画一个图框，打印还是偏移！！pg，audit用过n次。

图纸里面到底有什么？？？？

vba的帮助中，并没有提到setwindowtoplot的坐标系是displayDCS。

我曾试过在WCS和OCS之间转换，没有用，谢谢楼上兄弟提出的方法,

试验以后来汇报结果。

xxxtttxxx

感谢5楼兄弟，问题解决！！

pipilu1984

光介绍功能，要是能提供给用户使用多好

cq_qg

只有羡慕的份了，能不能发上来用一下？