VBA策划

deegeecees · 发表于 2006-10-12 17:31:11

在这里开发另一个QuickPlot程序。我对“SendCommand”场景没有问题，基本上是通过“vbCr”完成所有提示的命令行。效果很好。但是现在他们（用户）希望能够绘制模型空间布局的窗口部分。所以，这是我得到的：
旧方法：

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

这是我正在尝试开发的：

copy

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&UR角时有点错误。除此之外，它也有点俗气。
非常欢迎任何改进。

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

mohnston · 发表于 2006-10-12 18:18:57

我有一个VBA的快速绘图例程，但没有使用窗口。让我看看我可以添加什么

deegeecees · 发表于 2006-10-12 18:29:25

您可以尝试删除 SendCommand，它几乎总是会给您带来问题。在VB / VBA中绘图并不简单，但也并非不可能。
这可能会让您入门。请记住，我还没有测试过这个。

copy

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

deegeecees · 发表于 2006-10-12 18:57:48

感谢Cmdr，自从我能够处理任何与VBA相关的内容以来，已经有一段时间了。我一直在设计问题上努力工作，因此我呼吁武装起来。我很感激。

deegeecees · 发表于 2006-10-12 18:58:44

谢谢莫恩斯顿，我明天会发布结果。

mohnston · 发表于 2006-10-13 09:52:04

这是我的设置例程
，这就是我如何调用它并将大小、旋转、ctb等作为参数传递
现在我们需要做的就是生成一个窗口并将其输入。

deegeecees · 发表于 2006-10-13 09:56:03

我发现了这个

copy

layout.GetWindowToPlot LL,UR

，所以你需要做的就是
用

copy

dim LL(0 to 2) as double
dim UR(0 to 2) as double
'pseudo code getpoint LL and UR

将LL和UR定义为双精度。

deegeecees · 发表于 2006-10-13 11:16:31

谢谢Cmdr，今天有一个截止日期。在你和Mohnston之间，我想有足够的信息可以帮助我弄清楚。
Rush，Rush！
Zooom......

deegeecees · 发表于 2006-10-13 15:27:48

我把这件事做好了

copy

Dim LL As Variant, UR As Variant
    LL = ThisDrawing.Utility.GetPoint
    UR = ThisDrawing.Utility.GetPoint
    ThisDrawing.ModelSpace.AddLine LL, UR

所以我能够画一条线，所以你应该能够使用布局。GetWindowToPlot LL，UR

VBA策划

发表回复

精选推荐