[求助]VBA做打印的问题
<p><font face="Verdana">我做了一个打印的程序，因为自己使用做的比较简单，通过选择多段线方框或者图块来确定打印区域，来实现批量打印；本来小心操作的话用着没有问题，可是今天同事的 一个图拷过来打印的时候发现，打印区域会跑，偏移到空白的地方去了，但是把这张图的内容拷到一张新建的图里再打又能用了，不知道是什么问题，求助帮忙看下，下面的事全部的代码，有个窗体带了两个列表框，打印机和图纸的列表，谢谢！</font></p><p> </p>
<p><font face="Verdana">Private Sub CmdOK_Click()</font></p>
<p><font face="Verdana"> '保证选项完整<br/> If cmb1.text = "" Or cmb1.text = "无" Then<br/> Label1.Caption = "请选择打印机！"<br/> Exit Sub<br/> End If<br/> <br/> If cmb2.text = "" Then<br/> Label1.Caption = "请选择图纸类型！"<br/> Exit Sub<br/> End If<br/> <br/> '确保当前布局是模型空间<br/> ThisDrawing.ActiveLayout = ThisDrawing.Layouts.Item("Model")<br/> <br/> '设置打印设备<br/> If Not cmb1.text = "" Or cmb1.text = "无" Then<br/> ThisDrawing.ActiveLayout.ConfigName = cmb1.text<br/> Else<br/> ThisDrawing.ActiveLayout.C<br/> End If<br/> <br/> '设置打印比例为"布满图纸"<br/> ThisDrawing.ActiveLayout.StandardScale = acScaleToFit<br/> <br/> ' 设置图纸是否居中打印<br/> ThisDrawing.ActiveLayout.CenterPlot = True<br/> <br/> '设置图纸类型<br/> If Not cmb2.text = "" Then<br/> ThisDrawing.ActiveLayout.CanonicalMediaName = cmb2.text<br/> Else<br/> ThisDrawing.ActiveLayout.Can<br/> End If<br/> <br/> ThisDrawing.ActiveLayout.PaperUnits = acMillimeters<br/> <br/> ' 设置是否应用打印样式<br/> ThisDrawing.ActiveLayout.PlotWithPlotStyles = True</font></p>
<p><font face="Verdana"> ' 设置打印样式表<br/> ThisDrawing.ActiveLayout.StyleSheet = "Tarch7.ctb"<br/> <br/> '让AUTOCAD在前台进行打印<br/> ThisDrawing.SetVariable "BACKGROUNDPLOT", 0<br/> <br/> '--------------------设置打印窗口----------------------------------------<br/> Dim i As Integer<br/> Dim dkxset As AcadSelectionSet<br/> Dim element As AcadEntity<br/> Dim aaa As Long<br/> <br/> Dim fType(0 To 3) As Integer<br/> Dim fData(0 To 3) As Variant<br/> <br/> '设置过滤<br/> fType(0) = -4: fData(0) = "<or"<br/> fType(1) = 0: fData(1) = "INSERT"<br/> fType(2) = 0: fData(2) = "LWPOLYLINE"<br/> fType(3) = -4: fData(3) = "or>"<br/> <br/> On Error Resume Next<br/> Set dkxset = ThisDrawing.SelectionSets.Add("ss1")<br/> Me.Hide<br/> dkxset.SelectOnScreen fType, fData<br/> <br/> If Err Then<br/> Err.Clear<br/> Set dkxset = ThisDrawing.SelectionSets.Item("ss1")<br/> dkxset.Clear<br/> dkxset.Delete<br/> dkxset.SelectOnScreen fType, fData<br/> End If<br/> <br/> aaa = dkxset.Count<br/> <br/> i = 0<br/> <br/> Dim minxx() As Double<br/> Dim minyy() As Double<br/> Dim maxxx() As Double<br/> Dim maxyy() As Double<br/> <br/> ReDim minxx(aaa)<br/> ReDim minyy(aaa)<br/> ReDim maxxx(aaa)<br/> ReDim maxyy(aaa)<br/> <br/> For Each element In dkxset<br/> element.GetBoundingBox minpoint, maxpoint<br/> <br/> Call ThisDrawing.Utility.TranslateCoordinates(minpoint, acWorld, acDisplayDCS, False)<br/> Call ThisDrawing.Utility.TranslateCoordinates(maxpoint, acWorld, acDisplayDCS, False)<br/> <br/> minxx(i) = minpoint(0): minyy(i) = minpoint(1)<br/> maxxx(i) = maxpoint(0): maxyy(i) = maxpoint(1)<br/> i = i + 1<br/> Next<br/> <br/> dkxset.Clear<br/> dkxset.Delete<br/> Dim minpt(0 To 1) As Double, maxpt(0 To 1) As Double<br/> i = 0<br/> Dim num As Integer<br/> num = 0<br/> For i = 0 To aaa - 1<br/> If Not minxx(i) = maxxx(i) Or minyy(i) = maxyy(i) Then<br/> num = num + 1<br/> End If<br/> Next i<br/> <br/> Dim pt1(0 To 2) As Double<br/> Dim pt2(0 To 2) As Double<br/> For i = 0 To aaa - 1<br/> <br/> minpt(0) = minxx(i): minpt(1) = minyy(i)<br/> maxpt(0) = maxxx(i): maxpt(1) = maxyy(i)<br/> <br/> pt1(0) = minpt(0): pt1(1) = minpt(1): pt1(2) = 0<br/> Call ThisDrawing.ModelSpace.AddCircle(pt1, 200)<br/> pt2(0) = maxpt(0): pt2(1) = maxpt(1): pt2(2) = 0<br/> Call ThisDrawing.ModelSpace.AddCircle(pt2, 200)<br/> <br/> If Not minpt(0) = maxpt(0) Or minpt(1) = maxpt(1) Then<br/> '设置打印方向<br/> If (maxpt(0) - minpt(0)) < (maxpt(1) - minpt(1)) Then<br/> <br/> ThisDrawing.ActiveLayout.PlotRotation = ac0degrees '纵向<br/> Else<br/> <br/> ThisDrawing.ActiveLayout.PlotRotation = ac90degrees '横向<br/> End If<br/> '设置窗口对角点<br/> ThisDrawing.ActiveLayout.SetWindowToPlot minpt, maxpt<br/> <br/> '设置打印类型<br/> ThisDrawing.ActiveLayout.PlotType = acWindow<br/> <br/> '打印<br/> If Not cmb1.text = "" Or cmb1.text = "无" Then<br/> ThisDrawing.plot.PlotToDevice cmb1.text<br/> Else<br/> ThisDrawing.plot.PlotToDevice "Adobe PDF"<br/> End If<br/> Else<br/> num = num - 1<br/> End If<br/> Next i<br/> <br/> '恢复系统变量的值<br/> ThisDrawing.SetVariable "BACKGROUNDPLOT", 2<br/> <br/> ThisDrawing.Utility.Prompt num & "张图打印完毕！"<br/>End Sub</font></p> <p>在</p>
<p>'--------------------设置打印窗口----------------------------------------</p>
<p>上面加上</p>
<p><font style="BACKGROUND-COLOR: #00ff00" face="Verdana">' 重新生成当前图形<br/>ThisDrawing.Regen acActiveViewport</font></p>
<p>试试</p>
<p>-----------------------------------------------------</p>
<p>另外：</p>
<p>'设置打印设备<br/> If Not cmb1.text = "" Or cmb1.text = "无" Then<br/> ThisDrawing.ActiveLayout.ConfigName = cmb1.text<br/> Else<br/> <font style="BACKGROUND-COLOR: #ff0000">ThisDrawing.ActiveLayout.C</font><br/> End If</p>
<p>和</p>
<p>'设置图纸类型<br/> If Not cmb2.text = "" Then<br/> ThisDrawing.ActiveLayout.CanonicalMediaName = cmb2.text<br/> Else<br/> <font style="BACKGROUND-COLOR: #ff0000"> ThisDrawing.ActiveLayout.Can<br/></font> End If</p>
<p><br/>红色部分代码补全</p>
<p><br/> </p> <p>还是不行啊，主要问题可能出在这个循环这里，代码中在窗口的两个角点处画了两个圆做标记，点的位置没有错，但是选的窗口却偏移了好多</p>
<p>For i = 0 To aaa - 1<br/> <br/> minpt(0) = minxx(i): minpt(1) = minyy(i)<br/> maxpt(0) = maxxx(i): maxpt(1) = maxyy(i)<br/> <br/> pt1(0) = minpt(0): pt1(1) = minpt(1): pt1(2) = 0<br/> Call ThisDrawing.ModelSpace.AddCircle(pt1, 200)<br/> pt2(0) = maxpt(0): pt2(1) = maxpt(1): pt2(2) = 0<br/> Call ThisDrawing.ModelSpace.AddCircle(pt2, 200)<br/> <br/> If Not minpt(0) = maxpt(0) Or minpt(1) = maxpt(1) Then<br/> '设置打印方向<br/> If (maxpt(0) - minpt(0)) < (maxpt(1) - minpt(1)) Then<br/> <br/> ThisDrawing.ActiveLayout.PlotRotation = ac0degrees '纵向<br/> Else<br/> <br/> ThisDrawing.ActiveLayout.PlotRotation = ac90degrees '横向<br/> End If<br/> '设置窗口对角点<br/> ThisDrawing.ActiveLayout.SetWindowToPlot minpt, maxpt<br/> <br/> '设置打印类型<br/> ThisDrawing.ActiveLayout.PlotType = acWindow<br/> <br/> '打印<br/> If Not cmb1.text = "" Or cmb1.text = "无" Then<br/> ThisDrawing.plot.PlotToDevice cmb1.text<br/> Else<br/> ThisDrawing.plot.PlotToDevice "Adobe PDF"<br/> End If<br/> Else<br/> num = num - 1<br/> End If<br/> Next i<br/></p> 这个先记下了。研究研究。
页:
[1]