I have a template with three layouts, each having an acadpviewport2
I can set the scale of these viewports, but how can I make them point to a certain area of the modelspace?
Thanks!
|
I have a template with three layouts, each having an acadpviewport2
I can set the scale of these viewports, but how can I make them point to a certain area of the modelspace?
Thanks!
Last edited by mpruna; 2009-02-25 at 07:12 PM.
Here's a sub I wrote which should point you in the right direction.
Code:Public Sub VPExtentsBox() 'draws a box in MS representing the extents 'of the current PS viewport Dim oPsVp As AcadPViewport Dim oBox As AcadLWPolyline Dim dPt1(0 To 2) As Double Dim dPt2(0 To 2) As Double Dim vCtrPt As Variant Dim vCtrPt1 As Variant Dim vMinPoint As Variant Dim vMaxPoint As Variant Dim BBpoints(0 To 9) As Double 'Bounding box points list If ThisDrawing.ActiveSpace = acPaperSpace Then 'first check for tilemode = 0 If ThisDrawing.MSpace = True Then 'then make sure ms is active Set oPsVp = ThisDrawing.ActivePViewport vCtrPt = ThisDrawing.GetVariable("viewctr") VPCoords oPsVp, vMinPoint, vMaxPoint BBpoints(0) = vMinPoint(0): BBpoints(1) = vMinPoint(1) BBpoints(2) = vMaxPoint(0): BBpoints(3) = vMinPoint(1) BBpoints(4) = vMaxPoint(0): BBpoints(5) = vMaxPoint(1) BBpoints(6) = vMinPoint(0): BBpoints(7) = vMaxPoint(1) BBpoints(8) = vMinPoint(0): BBpoints(9) = vMinPoint(1) Set oBox = ThisDrawing.ModelSpace.AddLightWeightPolyline(BBpoints) vCtrPt1 = toolbox.ejMath.MidPoint(vMinPoint, vMaxPoint) dPt1(0) = vCtrPt1(0): dPt1(1) = vCtrPt1(1): dPt1(2) = vCtrPt1(2) dPt2(0) = vCtrPt(0): dPt2(1) = vCtrPt(1): dPt2(2) = vCtrPt(2) oBox.Move dPt1, dPt2 Else MsgBox "The active viewport must have ModelSpace active for this command to work.", vbExclamation, "Viewport Extents Box" End If Else MsgBox "You must be in paperspace with the active viewport in ModelSpace for this command to work.", vbExclamation, "Viewport Extents Box" End If End Sub Public Sub VPCoords(vp As AcadPViewport, ll, ur) 'Calculates the extents of a PaperSpace viewport in ModelSpace units 'Arguments: An AcadPViewport entity and two variants. ' The variants will be filled with the corner points. Dim min, MAX, oldMode As Boolean vp.GetBoundingBox min, MAX oldMode = ThisDrawing.MSpace ThisDrawing.MSpace = True ll = ThisDrawing.Utility.TranslateCoordinates(min, acPaperSpaceDCS, acDisplayDCS, False) ur = ThisDrawing.Utility.TranslateCoordinates(MAX, acPaperSpaceDCS, acDisplayDCS, False) ThisDrawing.MSpace = oldMode End Sub
Thanks Ed!
One thing I'm not clear on is how the coordinate translation from paperspace to modelspace units actually gives you the location of the viewport in the modelspace, since the viewport can point anywhere while staying in the same position in the paperspace.
There are at least 3 ways I can think of off the top of my head on how you might change the view. Use one of the app zoom methods, set the PViewport.ModelView property or use Center, Target, LensLength, Direction and TwistAngle or Center, Width, Height to manually calc a new view.
Hi Ed.
I actually looked into the modelview property but it shows as an empty object in my case.See the ekeleton of the code below.
Code:Dim myLayout As AcadLayout Dim myviewport As IAcadPViewport2 Dim my_scale As AcViewportScale For Each myLayout In my_dwg.Layouts my_dwg.ActiveLayout = myLayout For Each my_obj In my_dwg.PaperSpace If TypeOf my_obj Is IAcadPViewport2 Then Set myviewport = my_obj myviewport.StandardScale = acVpCustomScale aspectratiovp = myviewport.Width / myviewport.Height aspectratioraker = (rakwidth * 4 + 3 * 65) / rakheight If aspectratioraker > aspectratiovp Then myviewport.CustomScale = 4.5 * 2800 / (rakwidth * 4 + 3 * 65) / 1000 ' myviewport.ModelView.Center Modelview is an empty object (value=nothing). even though the viewports are actually showing objects in the model space, and I can set the scale just fine. I wanted to use the center coordinates to set the viewport in the right location. thanks. Else myviewport.CustomScale = 4.5 * 1500 / rakheight / 1000 End If End If Next Next
Last edited by Ed Jobe; 2009-02-27 at 04:08 PM. Reason: Added Code tags.
Here is my cleaned up version of your code.
myviewport.ModelView.Center would be nothing because no view has been set. The ModelView property is set to an AcadView object. You need to use the PViewport.Center property not the PViewport.ModelView.Center property.Code:Sub test() Dim myLayout As AcadLayout Dim myviewport As IAcadPViewport2 Dim my_scale As AcViewportScale Dim my_obj As AcadEntity Dim aspectratiovp As Double Dim aspectratioraker As Double Dim rakwidth As Double Dim rakheight As Double rakwidth = 100 rakheight = 100 For Each myLayout In ThisDrawing.Layouts ThisDrawing.ActiveLayout = myLayout For Each my_obj In ThisDrawing.PaperSpace If TypeOf my_obj Is IAcadPViewport2 Then Set myviewport = my_obj myviewport.StandardScale = acVpCustomScale aspectratiovp = myviewport.Width / myviewport.Height aspectratioraker = (rakwidth * 4 + 3 * 65) / rakheight If aspectratioraker > aspectratiovp Then myviewport.CustomScale = 4.5 * 2800 / (rakwidth * 4 + 3 * 65) / 1000 ' myviewport.ModelView.Center 'Modelview is an empty object (value=nothing). 'even though the viewports are actually showing objects 'in the model space, and I can set the scale just fine. 'I wanted to use the center coordinates 'to set the viewport in the right location. Else myviewport.CustomScale = 4.5 * 1500 / rakheight / 1000 End If End If Next Next End Sub
Last edited by Ed Jobe; 2009-02-27 at 10:52 PM.
thanks ed.
I tried to change the center property but that just pans the viewport on the paperspace, not it's target in the model space.