关于打印

weixin7944

一段关于打印的程序：

Sub Example_Plot()
Dim ptmin As Variant, ptmax As Variant
Dim ent As AcadEntity
Dim i As Integer
For Each ent In ThisDrawing.ModelSpace
If TypeOf ent Is AcadBlockReference Then
If StrComp(ent.Name, "TK", vbTextCompare) = 0 Then
ent.GetBoundingBox ptmin, ptmax
ReDim Preserve ptmin(0 To 1)
ReDim Preserve ptmax(0 To 1)
ThisDrawing.ActiveLayout.SetWindowToPlot ptmin, ptmax
   Dim currentPlot As AcadPlot
    Set currentPlot = ThisDrawing.Plot
    currentPlot.PlotToDevice "d:\wxa3.pc3"
    i = i + 1
    End If
    End If
    Next ent
   
End Sub

程序运行后，没有任何反应！不知道为什么，请高手指点！

alin

First you must have a block named "TK" in current drawing and a PC3 file name wxa.pc3 in D drive, then

Sub Example_Plot()
Dim ptmin As Variant, ptmax As Variant
Dim ent As AcadEntity
Dim i As Integer
For Each ent In ThisDrawing.ModelSpace
If TypeOf ent Is AcadBlockReference Then
If StrComp(ent.Name, "TK", vbTextCompare) = 0 Then
ent.GetBoundingBox ptmin, ptmax
ReDim Preserve ptmin(0 To 1)
ReDim Preserve ptmax(0 To 1)
ThisDrawing.ActiveLayout.SetWindowToPlot ptmin, ptmax
   Dim currentPlot As AcadPlot
    Set currentPlot = ThisDrawing.Plot
    ThisDrawing.ActiveLayout.PlotType = acWindow
    currentPlot.PlotToDevice "d:\wxa3.pc3"
    i = i + 1
    End If
    End If
    Next ent
   
End Sub

weixin7944

谢谢！该问题已解决。但是，新的问题又产生了：在d:\wxa3.pc3中已经设置了图纸的打印笔表，该笔表设置了各种颜色的线宽并设置了打印后全部为黑色（即黑白打印）。该笔表手动打印时效果正常。但是用上面的程序自动打印时，却没有体现出笔表的作用，打印出来为彩色的，无线宽区别的。

weixin7944

新编了一个程序如下：

Private Sub cmdOk_Click()
   Dim i As Integer
   Dim ii As Integer
   Dim zz As Integer
   Dim drn As String
   Dim drn1 As String
   Dim ptmin As Variant, ptmax As Variant
   Dim ent As AcadEntity
   Dim x As Integer
If lstFile.ListCount = 0 Then
MsgBox "请添加所要操作的图形！"
Exit Sub
End If
frmMain.hide
For i = 0 To lstFile.ListCount - 1
drn1 = lstFile.List(i)
Application.Documents.Open drn1
For Each ent In ThisDrawing.PaperSpace
If TypeOf ent Is AcadBlockReference Then
If StrComp(ent.Name, "TITLE", vbTextCompare) <> 0 Then
ent.GetBoundingBox ptmin, ptmax
Exit For
End If
End If
Next ent
ReDim Preserve ptmin(0 To 1)
ReDim Preserve ptmax(0 To 1)
    Dim currentPlot As AcadPlot
    Set currentPlot = ThisDrawing.Plot
    ThisDrawing.ActiveLayout.SetWindowToPlot ptmin, ptmax
    ThisDrawing.ActiveLayout.PlotType = acWindow
    If ComboBox1.Text = "ScaleToFit" Then
    ThisDrawing.ActiveLayout.StandardScale = acScaleToFit
    MsgBox TextBox2.Text
    ThisDrawing.ActiveLayout.StyleSheet = TextBox2.Text
    Else
    ThisDrawing.ActiveLayout.StandardScale = ac1_1
    ThisDrawing.ActiveLayout.StyleSheet = TextBox2.Text
    End If
   
       currentPlot.PlotToDevice TextBox1.Text
   Application.ActiveDocument.Close True, drn1
Next i

End Sub

程序运行到ThisDrawing.ActiveLayout.StyleSheet = TextBox2.Text处时出现错误，提示为INVALID INPUT.而TextBox2.Text的内容是笔表ctb文件的完整路径。删去此行时，程序运行完毕，但无笔表设置。请问为什么？