VBA绘图

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

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

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

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

' 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

layout.GetWindowToPlot LL,UR 

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

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