Jump to content

Modelspace coordinates from paperspace viewports?


hardwired

Recommended Posts

Hi,

 

How can i access the modelspace coordinates from paperspace viewports?

 

Is there a quick way or is it more complex than a simple property or in-built function?

Link to comment
Share on other sites

  • Replies 29
  • Created
  • Last Reply

Top Posters In This Topic

  • SEANT

    7

  • prab

    5

  • hardwired

    4

  • Jozi68

    3

Top Posters In This Topic

Can you just double click on the paperspace viewports and see your modelspace coord.? You can also draw an outline of your viewport there so when you go back to modelspace, you know exactly where the viewport is. I found a lisp that does it in one click.(draws the outline of your viewport in modelspace) I'll post it if you're interested.

Link to comment
Share on other sites

Yeah, that would be great please, would appreciate it. Although, i'm trying to do this in VBA, but anything that would help me understand the cience behind what i need to achieve would be great..

 

Basically what i'm trying to get is I want to create a rectangle (polyline) in modelspace to indicate where the viewport in paperspace in 'looking at'..

Link to comment
Share on other sites

Just now trying to study VBA, so cannot help with that right now. Got a lot of work to do, very busy at work this week.

 

Basically you will want to trace all viewports or selected viewports with a Polyline, then use CHSPACE to send them to Model Space, I would think. Will this be for all viewports and Layout Tabs or will it be for selected viewports and Tabs?

 

I do not think you will need the coordinates. If I get a chance I will see if I can get some code started if you need me to. Sounds like something I could use from time to time myself.

 

Post the LISP if you do not mind, JeepMaster.

Link to comment
Share on other sites

Yeah that way sounds good to me, anything that will as you say, trace the viewports and send them to modelspace..

 

I take it, that this way, i will need to find the limits of each viewport, draw polylines round each one, create a selection set of these polylines, then CHSPACE them to modelspace?

 

I take it also that CHSPACE would be done via SendCommand? If so, how can i send the selection set this command?

 

My program will have 3 options: Single pick for a single viewport, all viewports in current layout and all viewports in whole drawing, but just need to sort out the single one for now..

Link to comment
Share on other sites

Yeah that way sounds good to me, anything that will as you say, trace the viewports and send them to modelspace..

 

I take it, that this way, i will need to find the limits of each viewport, draw polylines round each one, create a selection set of these polylines, then CHSPACE them to modelspace?

 

I take it also that CHSPACE would be done via SendCommand? If so, how can i send the selection set this command?

 

My program will have 3 options: Single pick for a single viewport, all viewports in current layout and all viewports in whole drawing, but just need to sort out the single one for now..

 

Okay sounds like you have a grasp. Already getting behind at work. Will check some things at lunch for you. :thumbsup:

Link to comment
Share on other sites

There is more easy alhorithm. Find BoundingBox or PaperSpace Viewport and use TranslateCoordinates method to get Modelspace coordinates. Short VisualLisp example. Function to get Bottom-Left and Top-Right coordinates of PaperSpase Viewport in Model Space:

 

(defun GetPViewportLimitsOnModel(PViewport / cObj cPWp utObj mPt xPt lbCon trCon)
 (vl-load-com)
 (if
   (and
     PViewport
     (= "VIEWPORT"(cdr(assoc 0(entget(setq cPWp PViewport )))))
     ); end and
   (progn
     (setq cPWp(vlax-ename->vla-object cPWp)
    utObj(vla-get-Utility
	 (vla-get-ActiveDocument
	   (vlax-get-acad-Object))))
     (vla-GetBoundingBox cPWp 'mPt 'xPt)
     (setq lbCon(vla-TranslateCoordinates
	   utObj mPt acPaperSpaceDCS acDisplayDCS :vlax-false)
    trCon(vla-TranslateCoordinates
	   utObj xPt acPaperSpaceDCS acDisplayDCS :vlax-false)
    ); end setq
     (if(and lbCon trCon)
       (list
  (vlax-safearray->list(vlax-variant-value lbCon))
  (vlax-safearray->list(vlax-variant-value trCon))
  ); end list
       ); end if
     ); end progn
    ); end if
  ); end of GetPViewportLimitsOnModel

 

Checkup. Click PVIeport and this routine draws it's bound in ModelSpace:

 

(defun c:dmr(/ pv verLst)
 (setq pv(entsel "\nSelect PaperSpace Viewport > "))
 (if(setq verLst(GetPViewportLimitsOnModel(car pv)))
   (progn
     (setvar "TILEMODE" 1)
     (command "_.rectangle"(car verLst)(cadr verLst))
    ); end progn
   ); end if
 (princ)
 ); end of c:dmr

 

In VBA it's will be more short code (I think that).

Link to comment
Share on other sites

VBA example from Dmitry:

 

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

Link to comment
Share on other sites

Post the LISP if you do not mind, JeepMaster.

I found the lisp from jtbworld.com, but I rename the command to VPO. All you have to do is type VPO and click on the viewport in paperspace and it will draw it automatically for you.

 

;;; vp-outline.lsp (VPO)
;;;
;;; Creates a polyline in modelspace that
;;; has the outline of the selected viewport.
;;; Supports clipped viewports.
;;; If vp-outline is called when in mspace it detects
;;; the active viewport.
;;;
;;; c:vp-outline (C:VPO)
;;;
;;; By Jimmy Bergmark
;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved
;;; Website: [url="http://www.jtbworld.com"]www.jtbworld.com[/url]
;;; E-mail: [email="info@jtbworld.com"]info@jtbworld.com[/email]
;;;
;;; 2000-04-10
;;; 2003-11-19 Added support for drawing the outline in other ucs/view than world/current
;;;
;;; 2006-04-06 Added support for twisted views Tom Beauford
;;;
;;; Tested on AutoCAD 2000, 2000i, 2002, 2004, 2006, 2007
(vl-load-com)
(defun dxf (n ed) (cdr (assoc n ed)))
(defun ax:List->VariantArray (lst)
 (vlax-Make-Variant
   (vlax-SafeArray-Fill
     (vlax-Make-SafeArray
       vlax-vbDouble
       (cons 0 (- (length lst) 1))
     )
     lst
   )
 )
)
(defun c:VPO (/ ad ss ent pl plist xy n vpbl vpur msbl msur ven vpno ok)
 (setq ad (vla-get-activedocument (vlax-get-acad-object)))
 (if (= (getvar "tilemode") 0)
   (progn
     (if (= (getvar "cvport") 1)
       (progn
         (if (setq ss (ssget ":E:S" '((0 . "VIEWPORT"))))
           (progn
             (setq ent (ssname ss 0))
             (setq vpno (dxf 69 (entget ent)))
             (vla-Display (vlax-ename->vla-object ent) :vlax-true)
             (vla-put-mspace ad :vlax-true) ; equal (command "._mspace")
             ; this to ensure trans later is working on correct viewport
             (setvar "cvport" vpno)
;              (vla-put-mspace ad :vlax-false) ; equal (command "._pspace")
             (setq ok T)
           )
         )
       )
       (setq ent (vlax-vla-object->ename (vla-get-activepviewport ad))
             ok  T
       )
     )
     (if ok
       (progn
         (setq ven (vlax-ename->vla-object ent))
         (if (/= 1 (logand 1 (dxf 90 (entget ent)))) ; detect perspective
           (if (= (vla-get-clipped ven) :vlax-false)
              (progn                 ; not clipped
                (vla-getboundingbox ven 'vpbl 'vpur)
                  (setq vpbl  (trans (vlax-safearray->list vpbl) 3 2)
                        msbl  (trans vpbl 2 1)
                        msbl  (trans msbl 1 0)
                        vpur  (trans (vlax-safearray->list vpur) 3 2)
                        msur  (trans vpur 2 1)
                        msur  (trans msur 1 0)
                        vpbr (list (car vpur) (cadr vpbl)0)
                        msbr  (trans vpbr 2 1)
                        msbr  (trans msbr 1 0)
                        vpul (list (car vpbl) (cadr vpur)0)
                        msul  (trans vpul 2 1)
                        msul  (trans msul 1 0)
                        plist (list (car msbl) (cadr msbl)
                                           (car msbr) (cadr msbr)
                                           (car msur) (cadr msur)
                                           (car msul) (cadr msul)
                                    )
                   )
              )
              (progn                 ; clipped
                (setq pl    (entget (dxf 340 (entget ent)))
                      plist (vla-get-coordinates
                              (vlax-ename->vla-object (dxf -1 pl))
                            )
                      plist (vlax-safearray->list (vlax-variant-value plist))
                      n     0
                      pl    nil
                )
                (repeat (/ (length plist) 2)
                  (setq xy (trans (list (nth n plist) (nth (1+ n) plist)) 3 2)
                        xy  (trans xy 2 1)
                        xy  (trans xy 1 0)
                        pl (cons (car xy) pl)
                        pl (cons (cadr xy) pl)
                        n  (+ n 2)
                  )
                )
                (setq plist (reverse pl))
              )
           )
         )
         (setq plist (ax:List->VariantArray plist))
         (vla-Put-Closed
           (vla-AddLightWeightPolyline
             (vla-get-ModelSpace ad)
             plist
           )
           :vlax-True
         )
       )
     )
   )
 )
 (if ss(vla-put-mspace ad :vlax-false)) ; equal (command "._pspace"))
 (princ)
)

Link to comment
Share on other sites

Right, firstly thanks to everyone so far..

 

I have this code:

 

 

Option Explicit
Dim response As Integer 'Yes / No..
Dim layoutX As AcadLayout 'Single layout unit..
Dim layoutS As AcadLayouts 'ThisDrawing layouts..
Dim VP As AcadViewport 'Single viewport unit..
Dim VPs As AcadViewports 'ThisDrawing viewports..
Dim MView As AcadView 'Single View unit..
Dim MViewS As AcadViews 'ThisDrawing Views..
Dim ThisSS As AcadSelectionSets 'This drawing's selection sets..
Dim SSetX As AcadSelectionSet 'Selection set for single viewport..
Dim singleVP As AcadObject 'Picked object for single vp getentity..
Dim singlePICKPOINT As Variant 'Picked point for single vp getentity..
Dim VPsingle As AcadPViewport
Dim VPpoint1(0 To 2) As Double 'Single Viewport LowerLeftCorner point..
Dim VPpoint2(0 To 2) As Double 'Single Viewport UpperRightCorner point..
Dim PSpoint1 As Variant 'Single Viewport LowerLeftCorner point (for Translation)..
Dim PSpoint2 As Variant 'Single Viewport UpperRightCorner point (for Translation)..
Dim MSpoint1 As Variant 'Single Viewport LowerLeftCorner point (for Translation)..
Dim MSpoint2 As Variant 'Single Viewport UpperRightCorner point (for Translation)..
Dim ModelMarkerPointS(0 To 11) As Double 'Points for model marker polyline..
Dim ModelMarkerRect As AcadLWPolyline 'ModelSpace Marker Rectangle..

'********************************************
'************* MAIN JUMP BUTTON *************
'********************************************
Private Sub jumpBTN_Click()
'If pick single viewport option..
If picksingleOPT.Value = True Then
   ' Single pick option..
j2vFRM.hide
ThisDrawing.Utility.GetEntity singleVP, singlePICKPOINT, "Select a Viewport.."
If Err <> 0 Then
   Err.Clear
   Exit Sub
Else 'Else for error..
   If singleVP.ObjectName = "AcDbViewport" Then 'If block..
       MsgBox "This is a Viewport.."
       Set VPsingle = singleVP
       PSpoint1 = VPsingle.LowerLeftCorner
       PSpoint2 = VPsingle.UpperRightCorner
       MSpoint1 = ThisDrawing.Utility.TranslateCoordinates(PSpoint1, acPaperSpaceDCS, acDisplayDCS, False)
       MSpoint2 = ThisDrawing.Utility.TranslateCoordinates(PSpoint2, acPaperSpaceDCS, acDisplayDCS, False)
       
       ModelMarkerPointS(0) = MSpoint1(0): ModelMarkerPointS(1) = MSpoint1(1): ModelMarkerPointS(2) = 0
       ModelMarkerPointS(3) = MSpoint1(0) + MSpoint2(0): ModelMarkerPointS(4) = MSpoint1(1): ModelMarkerPointS(5) = 0
       ModelMarkerPointS(6) = MSpoint1(0) + MSpoint2(0): ModelMarkerPointS(7) = MSpoint1(1) + MSpoint2(1): ModelMarkerPointS( = 0
       ModelMarkerPointS(9) = MSpoint2(0): ModelMarkerPointS(10) = MSpoint1(1): ModelMarkerPointS(11) = 0
       Set ModelMarkerRect = ThisDrawing.ModelSpace.AddPolyline(ModelMarkerPointS)
   End If
End If 'If err.number <> 0..
j2vFRM.Show

....The code fails on the Set VPsingle = singleVP line, so how do i convert one declared varibale to another. I obvioulsy have an AcadObject as the object picked using the GetEntity mehtod, but want to convert that to a viewport object so i can get the BoundingBox or LowerLeftCorner / UpperRightCorner properties..

 

I can't think how to do it but once i can sort that, does the rest of the code look ok to everyone?

 

i can use ASMI's code for multiple viewports as i can use:

 

Dim VPX as AcadViewport
For Each VPX in ThisDrawing.Viewports
....
Next VPX

...code (can't I?) but for a single pick, i need to develop my own code i have..

 

Any ideas?

 

 

 

The MsgBox "This is a Viewport.." line is just a test i had to check whether i'd pcked the right object type as i went. Forgot to delete it out..

Link to comment
Share on other sites

  • 1 year later...

I need something similar, the vertexes of a polyline that outlines a viewport. This viewport may have a funny shape (ie. not rectangular). I need .net code for this. Any ideas?

Link to comment
Share on other sites

This example might be helpful as an interim step towards a PS Poly to MS Poly transfer.

 

The transformation from PS to MS is a bit tricky, especially with views not aligned with the WCS. The code below shows a simple Point to Point transformation for views plan to the WCS (clearly something else is needed for 3d views).

 

 

:nuke:Disclaimer: Code below has no quality assurance. If tested, proceed with care.

 

 

 

Imports Autodesk.AutoCAD.Runtime

Imports Autodesk.AutoCAD.ApplicationServices

Imports Autodesk.AutoCAD.DatabaseServices

Imports Autodesk.AutoCAD.EditorInput

Imports Autodesk.AutoCAD.Geometry

Imports Autodesk.AutoCAD.GraphicsSystem

 

    <CommandMethod("P2M")> _
Public Sub PaperPt2ModelPt()
       Dim vp As Autodesk.AutoCAD.DatabaseServices.Viewport
       Dim PickPt As Point3d
       Dim DerivedPt As Point3d
       Dim doc As Document = Application.DocumentManager.MdiActiveDocument
       Dim db As Database = doc.Database
       Dim ed As Editor = doc.Editor


       If db.TileMode Then
           ed.WriteMessage(vbLf & "Command only applicable to PaperSpace.")
           Exit Sub
       End If

       Using trans As Transaction = db.TransactionManager.StartTransaction()
           Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead) 'not to sure about this
           Try
               Dim vpOid As ObjectId = ed.ActiveViewportId
               vp = trans.GetObject(vpOid, OpenMode.ForRead)
               If vp.Number = 1 Then
                   Dim peo As PromptEntityOptions = New PromptEntityOptions(vbLf & "Select viewport: ")
                   peo.SetRejectMessage(vbLf & "Please Select only a viewport.")
                   peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.Viewport), False)
                   Dim per As PromptEntityResult = ed.GetEntity(peo)
                   If per.Status <> PromptStatus.OK Then Exit Sub
                   vpOid = per.ObjectId
                   vp = trans.GetObject(vpOid, OpenMode.ForRead)

               End If
               ed.SwitchToPaperSpace()
               If vp.ViewDirection <> New Vector3d(0.0, 0.0, 1.0) Then
                   ed.WriteMessage(vbLf & "Non WCS aligned VP.  Operation aborted.")
                   Exit Sub
               End If
               vp.Highlight()
               Dim ppo As PromptPointOptions = New PromptPointOptions(vbLf & "Select a Point: ")
               Dim ppr As PromptPointResult = ed.GetPoint(ppo)
               vp.Unhighlight()
               If ppr.Status <> PromptStatus.OK Then Exit Sub
               PickPt = ppr.Value
               PickPt = PickPt.Subtract(vp.CenterPoint.GetAsVector)
               PickPt = PickPt.MultiplyBy(1 / vp.CustomScale)
               Dim gsm As Manager = Application.DocumentManager.MdiActiveDocument.GraphicsManager
               Dim vpView As View = New View
               gsm.SetViewFromViewport(vpView, vp.Number)
               Dim viewMat As Matrix3d = vpView.ViewingMatrix.Inverse()
               DerivedPt = PickPt.TransformBy(viewMat)
               Dim strMsg As String = "In MS, the point is "
               strMsg = strMsg & (Math.Round(DerivedPt.X, 4)).ToString & ", "
               strMsg = strMsg & (Math.Round(DerivedPt.Y, 4)).ToString & ", "
               strMsg = strMsg & (Math.Round(DerivedPt.Z, 4)).ToString
               ed.WriteMessage(vbLf & strMsg)
           Catch
               ed.WriteMessage("Error: ")
           End Try
       End Using
   End Sub

Link to comment
Share on other sites

Thank you so much SEANT,

It is working beautifully, even when the viewport is not in WCS (I am working in 2D).

Do you know how to get a collection of all the viewports, and then all the vertexes of the viewports?

Link to comment
Share on other sites

I’m not sure if viewports in all layouts would be retrieved via an appropriately filtered Editor.SelectAll. It’s certainly possible.

 

Alternatively, the LayoutManage could be used to retrieve each Layout, which then allows iterating the associated BlockTableRecord.

 

Once all the viewports are isolated, the ID returned via the Viewport.NonRectClipEntityId Property, along with a call to trans.GetObject(ObjectID, OpenMode.ForRead), should retrieve useful border information.

 

Conceivably, a Select Case would be required to correctly process all possible border types, i.e., Circle, Ellipse, Polyline, etc.

 

No doubt, a rather complex routine, but should be doable. Unfortunately it is not something I have time to look into right now.

Link to comment
Share on other sites

Incidentally, here is that sample code from post #12 with a couple extra lines to allow point translation for 3D views.

 

 

    <CommandMethod("P2M")> _
   Public Sub PaperPt2ModelPt()
       Dim vp As Autodesk.AutoCAD.DatabaseServices.Viewport
       Dim PickPt As Point3d
       Dim DerivedPt As Point3d
       Dim doc As Document = Application.DocumentManager.MdiActiveDocument
       Dim db As Database = doc.Database
       Dim ed As Editor = doc.Editor


       If db.TileMode Then
           ed.WriteMessage(vbLf & "Command only applicable to PaperSpace.")
           Exit Sub
       End If

       Using trans As Transaction = db.TransactionManager.StartTransaction()
           Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead) 'not to sure about this
           Try
               Dim vpOid As ObjectId = ed.ActiveViewportId
               vp = trans.GetObject(vpOid, OpenMode.ForRead)

               If vp.Number = 1 Then
                   Dim peo As PromptEntityOptions = New PromptEntityOptions(vbLf & "Select viewport: ")
                   peo.SetRejectMessage(vbLf & "Please Select only a viewport.")
                   peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.Viewport), False)
                   Dim per As PromptEntityResult = ed.GetEntity(peo)
                   If per.Status <> PromptStatus.OK Then Exit Sub
                   vpOid = per.ObjectId
                   vp = trans.GetObject(vpOid, OpenMode.ForRead)

               End If
               ed.SwitchToPaperSpace()
               vp.Highlight()
               Dim ppo As PromptPointOptions = New PromptPointOptions(vbLf & "Select a Point: ")
               Dim ppr As PromptPointResult = ed.GetPoint(ppo)
               vp.Unhighlight()
               If ppr.Status <> PromptStatus.OK Then Exit Sub
               PickPt = ppr.Value
               PickPt = PickPt.Subtract(vp.CenterPoint.GetAsVector)
               PickPt = PickPt.MultiplyBy(1 / vp.CustomScale)
               Dim WorldPln As Plane = New Plane()
               Dim gsm As Manager = Application.DocumentManager.MdiActiveDocument.GraphicsManager
               Dim vpView As View = New View
               gsm.SetViewFromViewport(vpView, vp.Number)
               Dim viewMat As Matrix3d = vpView.ViewingMatrix.Inverse()
               Dim viewdir As Vector3d = vp.ViewDirection
               DerivedPt = PickPt.TransformBy(viewMat)
               DerivedPt = DerivedPt.Project(WorldPln, viewdir) 'for 3d views
               Dim strMsg As String = "In MS, the point is "
               strMsg = strMsg & (Math.Round(DerivedPt.X, 4)).ToString & ", "
               strMsg = strMsg & (Math.Round(DerivedPt.Y, 4)).ToString & ", "
               strMsg = strMsg & (Math.Round(DerivedPt.Z, 4)).ToString
               ed.WriteMessage(vbLf & strMsg)
           Catch
               ed.WriteMessage("Error: ")
           End Try
       End Using
   End Sub

Link to comment
Share on other sites

Thank SEANT,

I'm very new to .net, so this is still greek to me. I need to learn more before I will be able to implement any of this.

Link to comment
Share on other sites

  • 1 month later...
VBA example from Dmitry:

 

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

well im trying to do just opposite..i need to translate the modelspace point to paperspace and my code is:

public function returnpnt(byval point as pointd) return pointd

{

dim AcadDoc As AcadDocument

Dim myutli As Object

myutli = AcadDoc.Utility

dim ppnt as new pointd

 

ppnt=mutil.TranslateCoordinates(point, AcCoordinateSystem.acDisplayDCS, AcCoordinateSystem.acPaperSpaceDCS, False)

return ppnt

}

[code]

 

But as i run the code it gives me following error:

Library not registered. (Exception from HRESULT: 0x8002801D (TYPE_E_LIBNOTREGISTERED))

 

I've used utility.getpoint() successfully in another sub..so there cant be problem with missing references..What's wrong here..Anyone help plz..Its urgent

Link to comment
Share on other sites

Which variant of VB (VBA, VB6, VB.NET) are you using? If the code you posted above was a direct Copy and Paste then look at this line in your routine:

 

ppnt=[color="Red"]mutil[/color].TranslateCoordinates(point, AcCoordinateSystem.acDisplayDCS, AcCoordinateSystem.acPaperSpaceDCS, False) 

Link to comment
Share on other sites

thnks seant but i'll take u to my real probelm.

What i'm trying to do is:

i pick a point anywhere in modelspace and draw the drawing.

Now i need to create an ewlayout with a viewport of fixed dimension.Inside that viewport i need to fit the drawing of modelspace with scaling 1:1.

For that i'm doing:

Public Sub addlayouts(ByVal lname As String)

Dim oLayout As AcadLayout

For Each oLayout In AcadDoc.Layouts

If oLayout.Name "Model" Then

oLayout.Delete()

End If

Next

oLayout = AcadDoc.Layouts.Add(lname)

AcadDoc.ActiveLayout = oLayout

End Sub

[code]

This creates a newlayout with my supplied name i.e "lname"

 

Now i add a viewport in that layout(i.e active layout) with the following code

[code]

Public Sub CreatePViewports(ByVal point As PointD)

 

Dim newvport As AcadPViewport

Dim objLayout As AcadLayout

Dim objAcadObject As AcadObject

Dim dblPoint(2) As Double

Dim dblViewDirection(2) As Double

 

Dim dblHeight As Double

Dim dblWidth As Double

Dim dblOrigin(1) As Double

Dim ppnt As New PointD

Dim myutli As Object

myutli = AcadDoc.Utility

dblOrigin(0) = 0 : dblOrigin(1) = 0

 

'For paperviewports

AcadDoc.ActiveSpace = AcActiveSpace.acPaperSpace

 

 

objLayout = AcadDoc.ActiveLayout

 

 

dblWidth = 396

dblHeight = 195

 

 

'Clear the layout of old PViewports

For Each objAcadObject In AcadDoc.PaperSpace

If TypeName(objAcadObject) = "IAcadPViewport" Then

objAcadObject.Delete()

End If

Next

 

 

'ppnt=AcadDoc.Utility.TranslateCoordinates(point, AcCoordinateSystem.acDisplayDCS, AcCoordinateSystem.acPaperSpaceDCS, False)

dblPoint(0) = ppnt.X#

dblPoint(1) = ppnt.Y#

dblPoint(2) = 0.0#

newvport = AcadDoc.PaperSpace.AddPViewport(dblPoint, dblWidth, dblHeight)

 

 

newvport.CustomScale = 1

'objLayout.PlotOrigin = dblOrigin

 

newvport.Display(True)

AcadDoc.MSpace = True

AcadDoc.ActivePViewport = newvport

 

AcadDoc.Regen(AcRegenType.acAllViewports)

 

End Sub

[code]

 

my problem is the drawing doesn't fit inside the viewport and i dont know how to do that??

I was thinking of uisng translatecoordinates method to tranlate point in modelspace to paperspace but since that didn't worked out..i dunno what to do.

Er. can i create a view of modelspace with height and widht as that of my viewport and set that view as current for my viewport??

Link to comment
Share on other sites

It looks like you are hooking into AutoCAD from an external VB6 executable: Is that correct?

 

A couple of questions:

 

 

i pick a point anywhere in modelspace and draw the drawing.

 

This “drawing”, is it the only thing in ModelSpace?

 

It sounds like the drawing may be too large to fit inside the viewport with a CustomScale = 1: Is the plan to scale the viewport such that it will fit . . . . at one of the standard scale, perhaps?

Or -

The drawing would always fit a 1:1 viewport if centered correctly?

 

 

 

Also, this line seems to be referring to some custom class or User Defined Type: What are its specifications?

 

Dim ppnt As New PointD

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...