Topic: VBA Plotting

[deegeecees]

Working on yet another QuickPlot program here. I've had no problems with a "SendCommand" scenario, basically command lining through all the prompts via "vbCr". Works great. But NOW they (the users) want to be able to plot a windowed portion of the modelspace layout. So, here's what I've got:

Old method:

Code: [Select]

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
Here's what I'm trying to develop:

Code: [Select]

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
Works OK, except for being a bit buggy when there is no "rectangle" to choose LL & UR corners. Aside from that it's also a bit cheesy.

Any improvements are extremely welcomed.

[David Hall]

i have a quick plot routine for VBA, but not using  a window.  Let me see what I can add

[mohnston]

You could try dropping the SendCommand which will almost always give you problems. Plotting in VB/VBA is not simple but it isn't impossible either.
This might get you started. Keep in mind I haven't tested this.

Code: [Select]

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]

Thanks Cmdr, it's been a while since I've been able to work on anything VBA related. Been working my butt off on design issues, hence my call to arms. I appreciate it.

[deegeecees]

Thanks Mohnston, I'll post results tomorrow.

[David Hall]

This is my setup routine

Code: [Select]

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 Suband this is how I call it and pass in size, rotation, ctb etc as arguments

Code: [Select]

' 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
Now all we need to do is generate a window and feed that in.

[David Hall]

I found this

Code: [Select]

layout.GetWindowToPlot LL,UR so all you need to do is define LL and UR as doubles
with

Code: [Select]

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


[deegeecees]

Thanks Cmdr, got a deadline to meet today. Between you and Mohnston, I think there's enough info to help me figure it out.


Rush, rush rush!

Zooom....

[David Hall]

I got this to work

Code: [Select]

Dim LL As Variant, UR As Variant
    LL = ThisDrawing.Utility.GetPoint
    UR = ThisDrawing.Utility.GetPoint
    ThisDrawing.ModelSpace.AddLine LL, UR
so i was able to draw a line, so you should be able to use the Layout.GetWindowToPlot LL,UR