社区 › VB › VBA绘图

mohnston 发表于 2006-10-12 17:31:11

VBA绘图

正在开发另一个QuickPlot程序。本人&#039；我对a没有任何问题；SendCommand“；场景中，基本上通过“通过”命令行通过所有提示；vbCr；。效果很好。但现在他们（用户）希望能够绘制模型空间布局的窗口部分。这里是#039；这就是我&#039；我们得到了：旧方法：
Sub plt_18x24()
Call AcadApplication.RunMacro("Q:\Std\ACAD\Support\Lisp\drafting_db.dvb!plot_counter")
ThisDrawing.SendCommand "-plot" & vbCr & "y" & vbCr & "Model" & vbCr & "Oce TDS600 3.x.pc3" & vbCr & "ARCH expand C (24.00 x 18.00 Inches)" & vbCr & "inches" & vbCr & "Landscape" & vbCr & "no" & vbCr & "extents" & vbCr & "fit" & vbCr & "Center" & vbCr & "yes" & vbCr & "comed36x24.ctb" & vbCr & "yes" & vbCr & "n" & vbCr & vbCr & vbCr & vbCr
End Sub
此处#039；这就是我&#039；我正在努力发展：
Sub qplot_d_color()
Call AcadApplication.RunMacro("Q:\Std\ACAD\Support\Lisp\drafting_db.dvb!plot_counter")
    Dim point1 As Variant, point2 As Variant
    point1 = ThisDrawing.Utility.GetPoint(, "Click the lower-left of the window to plot.")
    ReDim Preserve point1(0 To 1)
    point2 = ThisDrawing.Utility.GetPoint(, "Click the upper-right of the window to plot.")
    ReDim Preserve point2(0 To 1)
    ThisDrawing.ActiveLayout.SetWindowToPlot point1, point2
    ThisDrawing.ActiveLayout.GetWindowToPlot point1, point2
ThisDrawing.SendCommand "-plot" & vbCr & "y" & vbCr & "Model" & vbCr & "DesignJet 500.pc3" & vbCr & "ARCH D (36.00 x 24.00 Inches)" & vbCr & "inches" & vbCr & "Landscape" & vbCr & "no" & vbCr & "window" & vbCr & vbCr & vbCr & "fit" & vbCr & "Center" & vbCr & "yes" & vbCr & "C-D-E_Color.ctb" & vbCr & "yes" & vbCr & "n" & vbCr & vbCr & vbCr & vbCr
End Sub
工作正常，除了没有'；矩形“；选择LL&amp；你的角落。除此之外；这也有点俗气
我们非常欢迎任何改进。

个性魅力 发表于 2006-10-12 18:18:57

我有VBA的快速绘图例程，但不使用；一扇窗户&nbsp；让我看看我能补充什么

超级粽子 发表于 2006-10-12 18:29:25

您可以尝试删除SendCommand，这几乎总是会给您带来问题。在VB/VBA中绘图并不简单，但它不是#039；这也不可能
这可能会让你开始。请记住我没有#039；t对此进行了测试
Public Sub foo()
    Dim config As AcadPlotConfiguration
    Set config = ThisDrawing.PlotConfigurations(ThisDrawing.ActiveLayout.ConfigName)
    config.ConfigName = "Oce TDS600 3.x.pc3"
    config.CanonicalMediaName = "ARCH expand C (24.00 x 18.00 Inches)"
    config.PlotType = acExtents
    config.CenterPlot = True
    config.StandardScale = acScaleToFit
    config.RefreshPlotDeviceInfo
    ThisDrawing.Plot.PlotToDevice config.ConfigName
   
End Sub

许愿树 发表于 2006-10-12 18:57:48

感谢Cmdr，它&#039；自从我&#039；我能做任何与VBA相关的事情。我一直在努力解决设计问题，因此我呼吁武装起来。我很感激。

监利人 发表于 2006-10-12 18:58:44

感谢莫恩斯顿，我&#039；明天我会公布结果。

奇缘国度 发表于 2006-10-13 09:52:04

这是我的设置例程Option Explicit
Public Sub SetupAndPlot(ByRef Plotter As String, CTB As String, SIZE As String, PSCALE As String, ROT As String)
    Dim Layout As AcadLayout
    On Error GoTo Err_Control
    Set Layout = ThisDrawing.ActiveLayout
    Layout.RefreshPlotDeviceInfo
    Layout.ConfigName = Plotter    ' CALL PLOTTER
    Layout.PlotType = acExtents
    Layout.PlotRotation = ROT    ' CALL ROTATION
    Layout.StyleSheet = CTB    ' CALL CTB FILE
    Layout.PlotWithPlotStyles = True
    Layout.PlotViewportBorders = False
    Layout.PlotViewportsFirst = True
    Layout.CanonicalMediaName = SIZE    ' CALL SIZE
    Layout.PaperUnits = acInches
    Layout.StandardScale = PSCALE    'CALL PSCALE
    Layout.ShowPlotStyles = False
    ThisDrawing.Plot.NumberOfCopies = 1
    Layout.CenterPlot = True
    Layout.ScaleLineweights = False
    Layout.RefreshPlotDeviceInfo
    ThisDrawing.Regen acAllViewports
    ZoomExtents
    Set Layout = Nothing
    ThisDrawing.Save
Exit_Here:
    Exit Sub
Err_Control:
    Select Case Err.Number
    Case "-2145320861"
      MsgBox "Unable to Save Drawing- " & Err.Description
    Case "-2145386493"
      MsgBox "Drawing is setup for Named Plot Styles." & (Chr(13)) & (Chr(13)) & "Run CONVERTPSTYLES command", vbCritical, "Change Plot Style"
    Case Else
      MsgBox "Unknown Error " & Err.Number
    End Select
End Sub 这就是我如何调用它，并将大小、旋转、ctb等作为参数传递' a few examples
Public Sub Vendor1117()
    Call SetupAndPlot("11x17Draft.pc3", "11X17-CHECKSET.ctb", "ANSI_B_(11.00_x_17.00_Inches)", acScaleToFit, ac90degrees)
    ThisDrawing.Plot.PlotToDevice
    ThisDrawing.Close (True)
End Sub
Public Sub VendorQuickPlotC()
    Call SetupAndPlot("OCE DesignJet 750C.pc3", "VENDOR MEDIUM.ctb", "ARCH_expand_C_(24.00_x_18.00_Inches)", acScaleToFit, ac0degrees)
    ThisDrawing.Plot.PlotToDevice
    ThisDrawing.Close (True)
End Sub
Public Sub VendorQuickPlotD()
    Call SetupAndPlot("OCE DesignJet 750C.pc3", "VENDOR MEDIUM.ctb", "ARCH_expand_D_(36.00_x_24.00_Inches)", ac1_1, ac0degrees)
    ThisDrawing.Plot.PlotToDevice
    ThisDrawing.Close (True)
End Sub 现在我们需要做的就是生成一个窗口并将其输入。

☆紫色爱情☆ 发表于 2006-10-13 09:56:03

我找到了这个layout.GetWindowToPlot LL,UR 所以你需要做的就是将LL和UR定义为具有
dim LL(0 to 2) as double
dim UR(0 to 2) as double
'pseudo code getpoint LL and UR

大学女生 发表于 2006-10-13 11:16:31

谢谢指挥官，今天有最后期限。在你和莫恩斯顿之间，我认为有#039；有足够的信息帮我弄清楚
快跑，快跑
缩放。。。。

帮助 发表于 2006-10-13 15:27:48

我把这件事做好了Dim LL As Variant, UR As Variant
    LL = ThisDrawing.Utility.GetPoint
    UR = ThisDrawing.Utility.GetPoint
    ThisDrawing.ModelSpace.AddLine LL, UR
所以我能够画一条线，所以你们应该能够使用布局。GetWindowToPlot LL，UR

查看完整版本: VBA绘图