[原创]VBA版 批量打印更新
本帖最后由 作者 于 2008-2-29 18:43:11 编辑 <br /><br /> <p>老版本：<a href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=64559&replyID=&skin=1">http://bbs.mjtd.com/forum.php?mod=viewthread&tid=64559&replyID=&skin=1</a></p><p>特点：<br/>1、图名、图号可以自动提取（可以配合编写图纸目录）（图名、图号不是块属性，可以方便地自由编辑）<br/>2、打印队列有顺序（出图有顺序 整理图纸就方便多了）<br/>3、队列中的图纸可以指定不同的打印参数（包括使用不同的打印机、打印式样、纸张等几乎所有的打印参数）<br/>4、配合第3点可以做到不同图幅的图纸用不同的纸张打印（一套图有多种图幅的情况非常普遍），通过简单设定即可一次出图<br/>5、VBA执行速度较快（相对Lisp），出图快</p><p> http://imgcash5.imageshack.us/img522/9720/82218168dr3.swf</p><p>新版的改进以及未来的设想：<br/>1、功能更加强大，不同的图纸可以具体指定参数<br/>2、屏幕中选择框选的图框时，图框的图号和图名一定要在屏幕中显示，否则会提取失败（图元多时 ZOOMALL 消耗时间太多，故放弃）<br/>3、界面变化较大，可以设定的参数更多<br/>4、未来争取可以多文档执行（有些院图纸是一个文件一张图的）</p> <p>让别人看看FLASH有什么意思，更多的信息呢？</p><p>程序呢？</p><p></p><p>其实我自己写的程序在某种规则下面已经实现了对不同尺寸图纸</p><p>自动识别的能力。虽然可能并不完善，但是总的来说，还是足够实用的。</p> <p>在某些情况下，一般都是图纸比较复杂（大）的情况下出现：</p><p>就是选择图框打印后，打印区域出现偏移，</p><p>或者打印内容只占图纸的一个小角落（已经设置布满图纸），</p><p>怀疑是否与坐标系有关，或者图纸版本有关。请教原因。</p> xxxtttxxx发表于2008-3-4 17:43:00static/image/common/back.gif在某些情况下，一般都是图纸比较复杂（大）的情况下出现：就是选择图框打印后，打印区域出现偏移，或者打印内容只占图纸的一个小角落（已经设置布满图纸），怀疑是否与坐标系有关，或者图纸版本<p>我觉得这个问题的确是CAD自身的问题，但是也只有极个别的DWG文件才会出现这种问题。</p><p>问题分析：其实这是CAD锁定打印对角角点错位照成的，换句话说选择的窗口大小还是对的，就是位置偏差了，有些图会差很远。</p><p>本人蹩脚的解决方法：参照偏差窗口进行手动X轴Y轴补偿，换句话说就是特意选择与图纸反向偏差相同距离的一个窗口，最后打印窗口就正好是图纸了。</p><p>另外，支持楼上的，请楼主透露点源码让我们过过瘾吧。。。<br/></p> xxxtttxxx发表于2008-3-4 17:48:00static/image/common/back.gif在某些情况下，一般都是图纸比较复杂（大）的情况下出现：就是选择图框打印后，打印区域出现偏移，或者打印内容只占图纸的一个小角落（已经设置布满图纸），怀疑是否与坐标系有关，或者图纸版本
<p>这个问题我倒是没有碰到过。是不是世界坐标、显示坐标的原因。下面的文字是我从网上摘录的。</p><p>VBA中GetPoint以及GetBoundingBox返回的是都是世界坐标(WCS),而ThisDrawing.ModelSpac<br/>e.Layout.SetWindowToPlot中使用的却是显示坐标(DCS),<br/>我们可以使用ThisDrawing.Utility.TranslateCoordinates(PtMax, acWorld, acDisplayDC<br/>S, False)将世界坐标转换成显示坐标，这样就不会出现打印的时候图像出现偏移。</p><p>Function KSDY(E As AcadEntity)<br/> E.GetBoundingBox PtMin, PtMax '返回的是世界坐标</p><p> '将世界坐标(WCS)转换为显示坐标(DCS)<br/> Dim PtMax_UCS As Variant<br/> Dim PtMin_UCS As Variant<br/> PtMax_UCS = ThisDrawing.Utility.TranslateCoordinates(PtMax, acWorld, acDisplayDCS, False)<br/> PtMin_UCS = ThisDrawing.Utility.TranslateCoordinates(PtMin, acWorld, acDisplayDCS, False)<br/> <br/> <br/> ' 将三维点转化为二维点坐标<br/> ReDim Preserve PtMin_UCS(0 To 1)<br/> ReDim Preserve PtMax_UCS(0 To 1)<br/> </p><p> ' 设置打印窗口(为显示坐标DCS)<br/> ThisDrawing.ModelSpace.Layout.SetWindowToPlot PtMax_UCS, PtMin_UCS<br/> <br/> <br/> If Me.OptionButton4.Value = True Then<br/> '启用打印预览<br/> ThisDrawing.ActiveLayout.GetWindowToPlot PtMax_UCS, PtMin_UCS<br/> ThisDrawing.ActiveLayout.PlotType = acWindow<br/> ThisDrawing.Plot.DisplayPlotPreview acFullPreview<br/> Else<br/> '打印当前的区域<br/> '若选中“打印到文件”<br/> If PlotTofile_CheckBox.Value Then<br/> If PlotFilesPath_ComboBox.Text = "" Then PlotFilesPath_ComboBox.Text = GetPath<br/> ThisDrawing.Plot.PlotToFile PlotFilesPath_ComboBox.Text & ThisDrawing.Name & "-" & n & ".plt"<br/> n = n + 1<br/> Else<br/> ThisDrawing.Plot.PlotToDevice ThisDrawing.ModelSpace.Layout.ConfigName<br/> End If<br/> End If<br/>End Function<br/></p> <p>出现这个问题的图纸非常奇怪，我把图上所有的东西都删除，但是有</p><p>一个图层无法删除，我用vba一段程序把这个图层和图层里面看不到的东西都删除了。</p><p>然后我再保存为R12，把$paperspace,和$modelspace都删除了,保存为R12</p><p>然后用cad2006打开，随便画一个图框，打印还是偏移！！pg，audit用过n次。</p><p>图纸里面到底有什么？？？？</p><p></p><p>vba的帮助中，并没有提到setwindowtoplot的坐标系是displayDCS。</p><p>我曾试过在WCS和OCS之间转换，没有用，谢谢楼上兄弟提出的方法,</p><p>试验以后来汇报结果。</p><p></p><p></p> <p>感谢5楼兄弟，问题解决！！</p> <p>光介绍功能，要是能提供给用户使用多好</p> 只有羡慕的份了，能不能发上来用一下？
页:
[1]