VBA打印模型空间。。

Bryco · 发表于 2008-2-13 09:59:15

您好，
最新程序i&#039；我试图做的是绘制模型空间标题栏，当我尝试下面的代码来绘制它们时，程序在PlotToDevice行崩溃，并说Method&#039；绘图到设备&#039；对象IAcadPlot的失败&#039

Private Sub cmdPLOT_Click()
For Each entityX In selectset
entityX.GetBoundingBox MinExt, MaxExt ' Get bounding box of each schedule..
' Set variables of each window plot point..
MinWin(0) = MinExt(0): MinWin(1) = MinExt(1)
MaxWin(0) = MaxExt(0): MaxWin(1) = MaxExt(1)
' Plot set-up code..
ThisDrawing.ModelSpace.Layout.PlotType = acWindow
ThisDrawing.ModelSpace.Layout.UseStandardScale = True
ThisDrawing.ModelSpace.Layout.StandardScale = acScaleToFit
ThisDrawing.ModelSpace.Layout.PlotRotation = ac90degrees
ThisDrawing.ModelSpace.Layout.CanonicalMediaName = "A4"
ThisDrawing.ModelSpace.Layout.PlotWithPlotStyles = True
ThisDrawing.ModelSpace.Layout.CenterPlot = True
ThisDrawing.ModelSpace.Layout.PaperUnits = acMillimeters
' Check for Colour or Black 'n' White..
If ColourOPT.Value = True Then
    ThisDrawing.ModelSpace.Layout.StyleSheet = "AbiCAD Pens.ctb"
ElseIf bwOPT.Value = True Then
    ThisDrawing.ModelSpace.Layout.StyleSheet = "STANDARD BLACK + GREY.ctb"
End If
ThisDrawing.ModelSpace.Layout.GetWindowToPlot MinWin, MaxWin
ThisDrawing.Plot.NumberOfCopies = 1
ThisDrawing.ModelSpace.Layout.ConfigName = "Xerox 32.pc3"
ThisDrawing.Plot.PlotToDevice
    
    Next entityX
End Sub

..这就是程序的工作方式，它的用意是：
用户表单有三种选择集方法来选择标题栏（pick、Window和All）-haven和#039；t编码为Pick或All，但Window可以正常工作。选择集查找每个TB的边界（在不同的层中）并查找边界框坐标。然后应该使用这些作为窗口绘图的坐标。上面的代码是我为绘图而拼凑的，但正如我所说的，它失败了，打印出来的只是一张空白的A4纸。有人能检查我的代码，看看有什么可能是错的和/或用VBA对整个绘图问题有更多的了解吗，Paul basepointdesignzltd。。

Bryco · 发表于 2008-2-13 10:43:29

如果不使用此lineThisDrawing.ModelSpace.Layout，代码是否会崩溃。CanonicalMediaName=“”；A4“
（旋转介质时更改名称）

Bryco · 发表于 2008-2-13 11:35:08

您好，
是的，我注释掉了CanonicalMediaName行，它成功了，但它在横向页面上打印了肖像。然后，我将PlotRotation线更改为1，而不是AC90度，并保留CanonicalMediaName线，它做了相同的操作-在横向页面上绘制肖像。下面是我检查图形的模型空间打印设置的一个小例程，运行后，CanonicalMediaName显示为A4，PlotRogation线显示为1

copy

' Get the current plot settings for the drawing..
Sub GetPlotSettings()
    
    Dim PlotTypeX As String
    PlotTypeX = ThisDrawing.ModelSpace.Layout.PlotType
    
        MsgBox _
        "The Plotter for the active layout is: " & ThisDrawing.ModelSpace.Layout.ConfigName & vbCr & _
        "The PlotStyle for the active layout is: " & ThisDrawing.ModelSpace.Layout.StyleSheet & vbCr & _
        "The Media (paper size) for the active layout is: " & ThisDrawing.ModelSpace.Layout.CanonicalMediaName & vbCr & _
        vbCr & _
        "The Scale for the active layout is: " & ThisDrawing.ModelSpace.Layout.StandardScale & vbCr & _
        "The Units for the active layout is: " & ThisDrawing.ModelSpace.Layout.PaperUnits & vbCr & _
        "The Plot Type for the active layout is: " & PlotTypeX & vbCr & _
        "The Plot Rotation for the active layout is: " & ThisDrawing.ModelSpace.Layout.PlotRotation _
        , vbInformation, "Get Plot Settings: " & ThisDrawing.Name
End Sub

所以，谢谢你的回复，至少它没有&#039；这次我不崩溃，现在只需要整理一下方向。有什么想法吗
干杯，Paul，basepointdesignzltd。。

Bryco · 发表于 2008-2-13 11:53:51

我要做的是手动绘制并保存对布局的更改，然后在代码顶部添加

copy

      Dim Layout As AcadLayout
      Set Layout = ThisDrawing.ActiveLayout
      Layout.RefreshPlotDeviceInfo

如果您一次遍历代码1行，您可以查看布局上的设置，并确保您的代码使用了正确的详细信息

Bryco · 发表于 2008-2-15 06:24:04

您好，我让它工作了一点，至少是绘图位，但它只会绘制保存的定义窗口（应用于布局），而不是我计划的选择窗口-它要做的是为每个选定的标题栏，它的意思是使用外边缘作为窗口坐标并依次绘制每个窗口，但显然我的代码还很正确
有什么想法吗？（完整代码在我之前的回复中）干杯，Paul.basepointdesignzltd。。

Bryco · 发表于 2008-2-15 12:00:21

从centerplot的帮助中继续尝试。

VBA打印模型空间。。

发表回复

精选推荐