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