社区 › VB › 关于打印

weixin7944 发表于 2006-8-22 22:08:00

关于打印

一段关于打印的程序：
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 发表于 2006-8-23 11:45:00

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 发表于 2006-8-23 20:08:00

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

weixin7944 发表于 2006-8-24 22:12:00

新编了一个程序如下：
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文件的完整路径。删去此行时，程序运行完毕，但无笔表设置。请问为什么？

查看完整版本: 关于打印