Plot window randomly offset
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
Re: Plot window randomly offset
I'm having the same issue. I'm using the frame-block to get the "boundingbox" coordinates. The coordinates of my window are passing through fine.
But somehow the window doesn't seem to start on the proper lowerleftcorner, but somewhere in the center of the drawing.
One suggestion was to change the postion of ".PlotType = acWindow" so it comes after / before ".SetWindowToPlot". This doesn't do anything.
Any other suggestions? Or perhaps someone has found the solution? I'm ready to try anything.
P.S.: Two other threads have been started with the same issue:
Quick printing with VBA !
Started by Noureddine, 2012-09-06 02:11 PM
Problem Plotting with VBA
Started by cwhitaker, 2005-06-06 06:17 PM
This one could really use a breakthrough.
Re: Plot window randomly offset
Yes! Found it already. On another site, but posting the solution here for other AUGI users.
'Pnt1 and Pnt2 are the original coordinates
Dim Pnt1DCS() As Double, Pnt2DCS() As Double
'Translate coordinates from WCS to DCS
Pnt1DCS = ThisDrawing.Utility.TranslateCoordinates(Pnt1, acWorld, acDisplayDCS, False)
Pnt2DCS = ThisDrawing.Utility.TranslateCoordinates(Pnt2, acWorld, acDisplayDCS, False)
ReDim Preserve Pnt1DCS(0 To 1) ' Change this to a 2D array for setwindowtoplot
ReDim Preserve Pnt2DCS(0 To 1) ' Change this to a 2D array for setwindowtoplot
Re: Plot window randomly offset
Quote:
Originally Posted by
CADfunk MC
Yes! Found it already. On another site, but posting the solution here for other AUGI users.
'Pnt1 and Pnt2 are the original coordinates
Dim Pnt1DCS() As Double, Pnt2DCS() As Double
'Translate coordinates from WCS to DCS
Pnt1DCS = ThisDrawing.Utility.TranslateCoordinates(Pnt1, acWorld, acDisplayDCS, False)
Pnt2DCS = ThisDrawing.Utility.TranslateCoordinates(Pnt2, acWorld, acDisplayDCS, False)
ReDim Preserve Pnt1DCS(0 To 1) ' Change this to a 2D array for setwindowtoplot
ReDim Preserve Pnt2DCS(0 To 1) ' Change this to a 2D array for setwindowtoplot
Is this case has solved ? I am have some as problem with this
Print loop in model
Re: Plot window randomly offset
If you have a problem, describe the problem in detail. Provide enough information for us to trouble shoot the problem. e.g. show your code.
Re: Plot window randomly offset
Quote:
Originally Posted by
Ed Jobe
If you have a problem, describe the problem in detail. Provide enough information for us to trouble shoot the problem. e.g. show your code.
My problem i have block with name "kop"
"kop" is border for A3 paper
And i want print all "kop" in window and send to printer
Re: Plot window randomly offset
That's not a problem. Its what you want to do. The definition of a "problem" is something that is failing. What is going wrong? Remember, I asked for information that we can trouble shoot (try to solve a problem) with. You also didn't show your code.
Re: Plot window randomly offset
Quote:
Originally Posted by
juninawan.wawan784198
My problem i have block with name "kop"
"kop" is border for A3 paper
And i want print all "kop" in window and send to printer
I found on another forum good for printing, maybe it will help you -Automatic batch printing a multiple format (rectangles, frames) of model space and layouts.
Re: Plot window randomly offset
Re: Plot window randomly offset
where is link
- - - Updated - - -
Code:
Sub PlotMultipleAreas()
Dim i As Integer
Dim Dwg As AcadDocument
Dim SS As AcadSelectionSet
Dim acObj As AcadObject
Dim acBl As AcadBlockReference
Dim acLwP As AcadPolyline
Dim ObjectNames As String
Dim pt1 As Variant, pt2 As Variant
Set Dwg = ActiveDocument
Dim t As String: t = Now
Set SS = Dwg.SelectionSets.Add(t)
Dwg.ActiveSpace = acModelSpace
With SS
.Clear
.SelectOnScreen
End With
If SS.Count = 0 Then GoTo QuitSub
ObjectNames = "AcDbBlockReference"
For Each acObj In SS
If InStr(1, ObjectNames, acObj.ObjectName) = 0 Then GoTo NextObject
acObj.GetBoundingBox pt1, pt2
pt1 = ThisDrawing.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
pt2 = ThisDrawing.Utility.TranslateCoordinates(pt2, acWorld, acDisplayDCS, False)
ReDim Preserve pt1(1)
ReDim Preserve pt2(1)
With Dwg.ModelSpace.Layout
.PlotType = acWindow
.CenterPlot = True
.SetWindowToPlot pt1, pt2
.GetWindowToPlot pt1, pt2
End With
i = i + 1
On Error Resume Next
Dwg.Plot.PlotToFile "C:\Users\wawang-pc\Documents\0\" & Chr(i) ' my dwg in so many block but only one show in folder
NextObject:
Next acObj
QuitSub:
Set SS = Nothing
Set Dwg = Nothing
End Sub
- - - Updated - - -
where is link that is blank cell