Hello to all,
I am trying to hardcode X and Y coordinates for multiple plotwindows within ModelSpace.
The initial plotsettings are made with the common plot dialog.
The new lowerleft and upperright coordinates are retrieved by GetBoundingBox for several blocks and polylines.
Code:
Sub PlotMultipleAreas()
Dim Dwg As AcadDocument
Dim SS As AcadSelectionSet
Dim acObj As AcadObject
Dim acBl As AcadBlockReference
Dim acLwP As AcadPolyline
Dim ObjectNames As String
Set Dwg = ActiveDocument
Set SS = Dwg.SelectionSets.Add("SS")
Dwg.ActiveSpace = acModelSpace
With SS
.Clear
.SelectOnScreen
End With
If SS.Count = 0 Then GoTo QuitSub
ObjectNames = "AcDbPolyline, AcDbBlockReference"
For Each acObj In SS
If InStr(1, ObjectNames, acObj.ObjectName) = 0 Then GoTo NextObject
acObj.GetBoundingBox pt1, pt2
With Dwg.ModelSpace.Layout
.PlotType = acWindow
.CenterPlot = True
.SetWindowToPlot ConvPt(pt1), ConvPt(pt2)
.GetWindowToPlot pt1, pt2
End With
Dwg.Plot.DisplayPlotPreview acFullPreview
NextObject:
Next acObj
QuitSub:
Set SS = Nothing
Dwg.SelectionSets.Item("SS").Delete
Set Dwg = Nothing
End Sub
Function ConvPt(Pt As Variant) As Variant
Select Case UBound(Pt)
Case 1
ReDim Preserve Pt(2)
Pt(0) = Pt(0): Pt(1) = Pt(1): Pt(2) = 0
Case 2
ReDim Preserve Pt(1)
Pt(0) = Pt(0): Pt(1) = Pt(1)
End Select
ConvPt = Pt
End Function
I use ConvPt(pt) for transforming two-element to three-element array of doubles and back.
In the plotpreview / hardcopy there is a significant, constant, totally random offset present. Am I missing something ?
Thanks in advance for your help.
Kind regards,
Erik Wijbrandts