关于打印

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

页: [1]

明经CAD社区's Archiver

关于打印