Topic: Lisp to Create viewport

[HasanCAD]

This is final release for lisp to create a viewport for selected area
Your comments are welcome

Code: [Select]

;|------------ Viewport Creator ----------------
    q_|_|| _\|| q_|| _\|

  - Select area
  - ask for viewport scale
  - Go to last layout (first at right)
  - Ask for center point of viewport
  - Create a viewport
  - view the selected area with the viewport
  Create stations for Prestresed tendon

------------------------------------------------
  Author: Hasan M. Asous, 2010
ALL RIGHT RESERVED TO ALL
  Contact: HasanCAD @ TheSwamp.org,
           asos2000 @ CADTutor.net
           HasanCAD@gmail.com
------------------------------------------------
  Version: 1      2012 07 01
________________________________________________
      |;

;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine Start      ;

(defun c:NV (/       doc      p1 p2 temp   mp
     scl      SC       cd:DWG_LayoutsList   res
     a       b        vpp vpdoc vp
    )

  (vl-load-com)
  (setq Doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
  (setq p1 (getpoint "\Select objects to view:"))
  (setq p2 (getcorner p1))
  (if
    (< (car (trans p2 1 0)) (car (trans p1 1 0)))
     (setq tmp p1
   p1  p2
   p2  tmp
     )
     T
  )
  (setq mp (list (/ (+ (car p1) (car p2)) 2)
(/ (+ (cadr p1) (cadr p2)) 2)
0.0
   )
  )

  (setq sc (cond ((getint (strcat "\nWhat is Viewport Scale 1: <"
  (itoa (setq sc (cond (sc)
       (50)
)
)
  )
  ">: "
  )
  )
)
(sc)
   )
  )
  (setq cd:DWG_LayoutsList
(vlax-for % (vla-get-layouts Doc)
   (setq res (cons (list (vla-get-name %)
(vla-get-TabOrder %)
%
   )
   res
     )
   )
)
  )
  (setvar "CTab"
  (caar (vl-sort cd:DWG_LayoutsList
'(lambda (a b) (> (cadr a) (cadr b)))
)
  )
  )

  (setq VPDoc (vla-get-PaperSpace doc))
  (setq VPp (vlax-3D-point (getpoint "\nSelect Point for Viewport")))
  (setq VP (vla-AddPViewport
     VPDoc
     VPp
     (/ (- (car p2) (car p1)) sc)
     (/ (- (cadr p2) (cadr p1)) sc)
   )
  )
  (vla-display VP :vlax-true)
  (vla-put-mspace doc :vlax-true)
  (vla-put-activepviewport Doc VP)
  (vla-zoomcenter
    (vlax-get-acad-object)
    (vlax-3d-point mp)
    1.0
  )
  (vl-cmdf "_.zoom" (strcat (RTOS (/ 1.0 SC)) "xp"))
  (vla-regen (vla-get-activedocument (vlax-get-acad-object))
     acActiveViewport
  )
  (vla-put-mspace doc :vlax-FALSE)
  (VLA-PUT-DisplayLocked VP :vlax-true)
)


;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine End        ;

(princ "\n Type  NV  to Invoke")
(princ)
Updated

[kruuger]

hi HasanCAD

lisp not working. there are missing data for VPP variable (center of viewport in paper space).

kruuger

[HasanCAD]

Updated

[kruuger]

Updated

if you don't mind. Probably still not perfect:

Code - Auto/Visual Lisp: [Select]

1. (defun c:NV (/ *error* _RestoreView p1 p2 doc ct vs vc tmp mp sc ll res vpdoc vpp vp ans)
2.   (defun *error* (Msg)
3.     (princ "Error: ")
4.     (princ Msg)
5.     (if ct (_RestoreView))
6.     (princ)
7.   )
8.   (defun _RestoreView ()
9.     (setvar "ctab" ct)
10.     (vla-ZoomCenter (vlax-Get-Acad-Object) (vlax-3d-Point (trans vc 1 0)) vs)
11.   )
12.   (vl-load-com)
13.   (if (/= (getvar "cvport") 1)
14.     (if
15.       (and
16.         (setq p1 (getpoint "\nSelect first point of view: "))
17.         (setq p2 (getcorner p1 "\nSelect second point of view: "))
18.       )
19.       (progn
20.         (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
21.               ct (getvar "ctab")
22.               vs (getvar "viewsize")
23.               vc (getvar "viewctr")
24.               sc (cond
25.                    ( (getint
26.                        (strcat
27.                          "\nWhat is Viewport Scale 1: <"
28.                          (itoa (setq sc (cond (sc) (50))))
29.                          ">: "
30.                        )
31.                      )
32.                    )
33.                    ( sc )
34.                  )
35.         )
36.         (setq ll
37.           (vlax-for % (vla-get-layouts doc)
38.             (setq res
39.               (cons
40.                 (list
41.                   %
42.                   (vla-get-TabOrder %)
43.                 )
44.                 res
45.               )
46.             )
47.           )
48.         )
49.         (vla-put-ActiveLayout doc
50.           (caar
51.             (vl-sort ll
52.              '(lambda (a b)
53.                 (> (cadr a) (cadr b))
54.               )
55.             )
56.           )
57.         )
58.         (vla-put-MSpace doc :vlax-false)
59.         (if (setq vpp (getpoint "\nSelect Point for Viewport: "))
60.           (progn
61.             (if
62.               (<
63.                 (car (trans p2 1 0))
64.                 (car (trans p1 1 0))
65.               )
66.               (setq tmp p1 p1 p2 p2 tmp)
67.             )
68.             (setq mp
69.               (list
70.                  (/ (+ (car p1) (car p2)) 2)
71.                  (/ (+ (cadr p1) (cadr p2)) 2)
72.                  0.0
73.               )
74.             )
75.             (setq vpdoc (vla-get-PaperSpace doc)
76.                   vp (vla-AddPViewport
77.                        vpdoc
78.                        (vlax-3d-point vpp)
79.                        (/ (- (car p2) (car p1)) sc)
80.                        (/ (- (cadr p2) (cadr p1)) sc)
81.                      )
82.             )
83.             (vla-display vp :vlax-true)
84.             (vla-put-MSpace doc :vlax-true)
85.             (vla-put-ActivePViewport doc vp)
86.             (vla-ZoomCenter
87.               (vlax-get-acad-object)
88.               (vlax-3d-point mp)
89.               1.0
90.             )
91.             (vla-put-CustomScale vp (/ 1. sc))
92.             (vla-put-MSpace doc :vlax-false)
93.             (vla-put-DisplayLocked vp :vlax-true)
94.             (initget "Yes No")
95.             (setq ans
96.               (cond
97.                 ( (getkword "\nBack to model space [Yes/No] <No>: ") )
98.                 ( "No" )
99.               )
100.             )
101.             (if (= ans "Yes") (_RestoreView))
102.           )
103.           (progn
104.             (princ "\n** Invalid Point ** ")
105.             (if ct (_RestoreView))
106.           )
107.         )
108.       )
109.       (princ "\n** Invalid Point ** ")
110.     )
111.     (princ "\nStart Program in Model Space ")
112.   )
113.   (princ)
114. )
115. (princ "\n Type NV to Invoke ")
116. (princ)

kruuger

[KewlToyZ]

My routines below:

Code - Auto/Visual Lisp: [Select]

1. (defun c:vpt()
2. ;===================Turn off command line responses==============
3. (command "CMDECHO" 0);DO NOT CHANGE THIS LINE
4. ;=======================================================       
5.        
6.         (setq userlayer (getvar "clayer"))
7.         (setq ds2 (getvar "dimscale"))
8.         (setq userview (getvar "ctab"))
9.         (setq myTile (getvar "TILEMODE"))
10.         (autoload "LRG" '("LRG"))
11.         (autoload "MPL" '("MPL"))
12.        
13.         (if (> 0 myTile)
14.                         (prompt "\n   Switching view tab......")
15.                         (command "tilemode" 0)
16.         )
17.  
18.         (c:LRG)
19.         (setvar "CLAYER" "G-VIEW-PORT")        
20.        
21.         (princ "\n")
22.         (command "osmode" "523")
23.         (princ "\n")
24.         (command "mview")
25.         (princ "\n")
26.         (command (setq p1 (getpoint "\n   Select first corner of window opening: ")))
27.         (prompt "\n ")
28.         (command (getcorner p1 "\n   Select opposite corner of window opening: "))
29.         (prompt "\n ")
30.         (command "mspace")
31.        
32.         ; moved MPL for set scale to invoke in mspace only
33.         (c:MPL)
34.        
35.         (princ "\n")
36.         (command "zoom" "e")
37.         (princ "\n")
38.         (command "zoom" "c")
39.         (princ "\n")
40.         (command (getpoint "\n   Select center of view:"))
41.         (princ "\n")
42.         (command (strcat "1/" (rtos (getvar "dimscale") 2 0) "xp"))
43.         (princ "\n")
44.         (command "pspace")
45.         (princ "\n")
46.         (setvar "psltscale" 0)
47.         (princ "\n")
48.         (prompt "\n   DIMSCALE returning to original setting. ")
49.         (princ "\n")
50.         (setvar "dimscale" ds2)
51.        
52. ;===================Turn on command line responses==============
53. (command "CMDECHO" 1);DO NOT CHANGE THIS LINE
54. ;======================================================
55.         (prompt "\n   Returning view and layer.....")
56.         (command "ctab" userview)
57.         (command "clayer" userlayer)
58.         (prompt "\n   View and layer returned!")
59.         (princ)
60. )
61.  

[martinle]

This is final release for lisp to create a viewport for selected area
Your comments are welcome

Code: [Select]

;|------------ Viewport vreator ----------------
    q_|_|| _\|| q_|| _\|

  - Select area
  - ask for viewport scale
  - Go to last layout (first at right)
  - Ask for center point of viewport
  - Create a viewport
  - view the selected area with the viewport
  Create stations for Prestresed tendon

------------------------------------------------
  Author: Hasan M. Asous, 2010
ALL RIGHT RESERVED TO ALL
  Contact: HasanCAD @ TheSwamp.org,
           asos2000 @ CADTutor.net
           HasanCAD@gmail.com
------------------------------------------------
  Version: 1      2012 07 01
________________________________________________
      |;

;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine Start      ;

(defun c:NV (/       doc      p1 p2 temp   mp
     scl      SC       cd:DWG_LayoutsList   res
     a       b        vpp vpdoc vp
    )

  (vl-load-com)
  (setq Doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
  (setq p1 (getpoint "\Select objects to view:"))
  (setq p2 (getcorner p1))
  (if
    (< (car (trans p2 1 0)) (car (trans p1 1 0)))
     (setq tmp p1
   p1  p2
   p2  tmp
     )
     T
  )
  (setq mp (list (/ (+ (car p1) (car p2)) 2)
(/ (+ (cadr p1) (cadr p2)) 2)
0.0
   )
  )

  (setq sc (cond ((getint (strcat "\nWhat is Viewport Scale 1: <"
  (itoa (setq sc (cond (sc)
       (50)
)
)
  )
  ">: "
  )
  )
)
(sc)
   )
  )
  (setq cd:DWG_LayoutsList
(vlax-for % (vla-get-layouts Doc)
   (setq res (cons (list (vla-get-name %)
(vla-get-TabOrder %)
%
   )
   res
     )
   )
)
  )
  (setvar "CTab"
  (caar (vl-sort cd:DWG_LayoutsList
'(lambda (a b) (> (cadr a) (cadr b)))
)
  )
  )

  (setq VPDoc (vla-get-PaperSpace doc))
  (setq VPp (vlax-3D-point (getpoint "\nSelect Point for Viewport")))
  (setq VP (vla-AddPViewport
     VPDoc
     VPp
     (/ (- (car p2) (car p1)) sc)
     (/ (- (cadr p2) (cadr p1)) sc)
   )
  )
  (vla-display VP :vlax-true)
  (vla-put-mspace doc :vlax-true)
  (vla-put-activepviewport Doc VP)
  (vla-zoomcenter
    (vlax-get-acad-object)
    (vlax-3d-point mp)
    1.0
  )
  (vl-cmdf "_.zoom" (strcat (RTOS (/ 1.0 SC)) "xp"))
  (vla-regen (vla-get-activedocument (vlax-get-acad-object))
     acActiveViewport
  )
  (vla-put-mspace doc :vlax-FALSE)
  (VLA-PUT-DisplayLocked VP :vlax-true)
)


;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine End        ;

(princ "\n Type  NV  to Invoke")
(princ)
Updated

Hello HasanCAD

The Lisp works very well. It would be great if you could choose the layout where you want to create the view window.
Would this be feasible?

Martin

[HasanCAD]

Updated

if you don't mind. Probably still not perfect:
...
kruuger

Of course i would not mind, but give me a time to study yours, compare with mine and see what is missing in mine.
Thanks Krugger for development.

[HasanCAD]

My routines below:
...

Thanks for new idea
but gives error

Code: [Select]

Initializing...
      Scale list being loaded, Please be patient......
bad argument type: numberp: nil

[KewlToyZ]

My routines below:
...

Thanks for new idea
but gives error

Code: [Select]

Initializing...
      Scale list being loaded, Please be patient......
bad argument type: numberp: nil

I have heard that before. I use it with my own settings and I am not sure what others are missing. I got it working in versions 2010 through 2013 on my end, but I have a reactor built into the startup from here for ScaleListEdit. I'm just wondering what variables I am missing for it.

[kruuger]

My routines below:

Code: [Select]

(defun c:vpt()
;=============================================================================Turn off command line responses
(command "CMDECHO" 0);DO NOT CHANGE THIS LINE
;=============================================================================

(setq userlayer (getvar "clayer"))
(setq ds2 (getvar "dimscale"))
(setq userview (getvar "ctab"))
(setq myTile (getvar "TILEMODE"))
(autoload "LRG" '("LRG"))
;(autoload "setviewscale" '("setviewscale"))
(autoload "MPL" '("MPL"))
;(setq vptLayer ("G-VIEW-PORT"))

;(> <NUMB1> <NUMB2>)                      Returns T if <NUMB1>is greater than <NUMB2>.
(if (> 0 myTile)
(prompt "\n   Switching view tab......")
(command "tilemode" 0)
)

(c:LRG)
(setvar "CLAYER" "G-VIEW-PORT")   

(princ "\n")
(command "osmode" "523")
(princ "\n")
(command "mview")
(princ "\n")
(command (setq p1 (getpoint "\n   Select first corner of window opening: ")))
(prompt "\n ")
(command (getcorner p1 "\n   Select opposite corner of window opening: "))
(prompt "\n ")
(command "mspace")

; moved setscale to invoke in mspace only
;(c:setviewscale)
(c:MPL)

(princ "\n")
(command "zoom" "e")
(princ "\n")
(command "zoom" "c")
(princ "\n")
(command (getpoint "\n   Select center of view:"))
(princ "\n")
(command (strcat "1/" (rtos (getvar "dimscale") 2 0) "xp"))
(princ "\n")
    (command "pspace")
    (princ "\n")
(setvar "psltscale" 0)
(princ "\n")
(prompt "\n   DIMSCALE returning to original setting. ")
(princ "\n")
(setvar "dimscale" ds2)

;=============================================================================Turn off command line responses
(command "CMDECHO" 1);DO NOT CHANGE THIS LINE
;=============================================================================
(prompt "\n   Returning view and layer.....")
(command "ctab" userview)
(command "clayer" userlayer)
(prompt "\n   View and layer returned!")
(princ)
)


i saw that you are using some subroutine form here: http://web2.airmail.net/terrycad/AutoLISP-Code.htm (like set_tile_list, maybe more)
without loading some additional function program will not work.
kruuger

[KewlToyZ]

My routines below:

Code - Auto/Visual Lisp: [Select]

1. (defun c:vpt()
2. ;=============================================================================Turn off command line responses
3. (command "CMDECHO" 0);DO NOT CHANGE THIS LINE
4. ;============================================================================= 
5.        
6.         (setq userlayer (getvar "clayer"))
7.         (setq ds2 (getvar "dimscale"))
8.         (setq userview (getvar "ctab"))
9.         (setq myTile (getvar "TILEMODE"))
10.         (autoload "LRG" '("LRG"))
11.         (autoload "MPL" '("MPL"))
12.        
13.         (if (> 0 myTile)
14.                         (prompt "\n   Switching view tab......")
15.                         (command "tilemode" 0)
16.         )
17.  
18.         (c:LRG)
19.         (setvar "CLAYER" "G-VIEW-PORT")        
20.        
21.         (princ "\n")
22.         (command "osmode" "523")
23.         (princ "\n")
24.         (command "mview")
25.         (princ "\n")
26.         (command (setq p1 (getpoint "\n   Select first corner of window opening: ")))
27.         (prompt "\n ")
28.         (command (getcorner p1 "\n   Select opposite corner of window opening: "))
29.         (prompt "\n ")
30.         (command "mspace")
31.        
32.         ; moved MPL set scale to invoke in mspace only
33.         (c:MPL)
34.        
35.         (princ "\n")
36.         (command "zoom" "e")
37.         (princ "\n")
38.         (command "zoom" "c")
39.         (princ "\n")
40.         (command (getpoint "\n   Select center of view:"))
41.         (princ "\n")
42.         (command (strcat "1/" (rtos (getvar "dimscale") 2 0) "xp"))
43.         (princ "\n")
44.         (command "pspace")
45.         (princ "\n")
46.         (setvar "psltscale" 0)
47.         (princ "\n")
48.         (prompt "\n   DIMSCALE returning to original setting. ")
49.         (princ "\n")
50.         (setvar "dimscale" ds2)
51.        
52. ;=============================================================================Turn off command line responses
53. (command "CMDECHO" 1);DO NOT CHANGE THIS LINE
54. ;============================================================================= 
55.         (prompt "\n   Returning view and layer.....")
56.         (command "ctab" userview)
57.         (command "clayer" userlayer)
58.         (prompt "\n   View and layer returned!")
59.         (princ)
60. )
61.  

i saw that you are using some subroutine form here: http://web2.airmail.net/terrycad/AutoLISP-Code.htm (like set_tile_list, maybe more)
without loading some additional function program will not work.
kruuger

Yes I included the additional routines in my zip file?
One is a layer insert routine, the other is a scale setting routine.

[antistar]

HasanCAD,
Congratulations, this routine is very helpful to me.
However, in some designs, it returns the following error:

Select Point for Viewport
ERROR: Automation Error. Invalid arqument Height in AddPViewport method

I work in centimeters.

Now a suggestion:
I work with many layouts in drawings.
There are how to select layout that I want to creat the viewport?

Thanks in advance

[kruuger]

Now a suggestion:
I work with many layouts in drawings.
There are how to select layout that I want to creat the viewport?

The Lisp works very well. It would be great if you could choose the layout where you want to create the view window.
Would this be feasible?

you can try this one.
kruuger

[martinle]

Hello Kruuger!

Unfortunately I get an error message:


command:
Select Point for Viewport: Error: Automation error Invalid argument
Height in methodRegeneriert AddPViewport model.

Martin

[kruuger]

Hello Kruuger!

Unfortunately I get an error message:


command:
Select Point for Viewport: Error: Automation error Invalid argument
Height in methodRegeneriert AddPViewport model.

Martin

hmm, this is very weird.
sometimes is Invalid Height, sometimes Error setting current viewportRestoring cached viewports. and sometimes is working.
i will try to investigate this. maybe replace with (command "vports" ...)
kruuger

[martinle]

Hello Mr. Kruuger!

I believe I have found the error.
When I go to "Select first point of view:" A window on the lower left to upper right aufziehe then it works. When I became a window from bottom right to top left aufziehe is the error message!
Could this be the problem?

Martin

[martinle]

addendum:

Hello Mr. Kruuger

Furthermore, I noticed when ucs not "world" then it brings the wrong section of the layout.
Maybe this helps even more.

Martin

[Lee Mac]

After a brief glance over the code, as a quick fix I would say change Line 83 / 84:

Code: [Select]

(/ (- (car p2) (car p1)) sc)
(/ (- (cadr p2) (cadr p1)) sc)
to:

Code: [Select]

(abs (/ (- (car p2) (car p1)) sc))
(abs (/ (- (cadr p2) (cadr p1)) sc))

[martinle]

Hello Mr. Kruuger
Hello Mr. Lee!

After the change, according to Mr. Lee is now no error message.
It works in the "UCS" world very well.
But if I have turned my plan in model space in the user coordinate system and then create a new viewport does not fit the new viewport in the layout. The section shown is postponed.
As I said, everything fits in the world UCS. Not only in the user coordinate system.

Greetings

Martin

[Hugo]

Hallo

I would like to have the insertion point of the bottom left to change what I need there.
Thank you

Ich würde gern den Einfügepunkt links unten haben was muss ich da ändern.
Danke

[smemo]

This is the version I wrote a while ago and I also used to improve the functions of:
Bill Kramer: "HarryDialog1.lsp/dcl";
Tee Square Graphics: "SAVARS.LSP";
Gilles Chanteau: "ArchSort" and "SplitStr";
Marc'Antonio Alessi: "ALE_ReplaceFirst" and "ALE_List_RemoveNth";
Lee McDonnell: "ADjoin", "toTop", "Remove_nth", "write_config", "read_config" and "GetLays".
LOAD.LSP the file used to load the various lisp.
CFL to run
I hope I have made ​​a decent translation

[antistar]

This is the version I wrote a while ago and I also used to improve the functions of:
Bill Kramer: "HarryDialog1.lsp/dcl";
Tee Square Graphics: "SAVARS.LSP";
Gilles Chanteau: "ArchSort" and "SplitStr";
Marc'Antonio Alessi: "ALE_ReplaceFirst" and "ALE_List_RemoveNth";
Lee McDonnell: "ADjoin", "toTop", "Remove_nth", "write_config", "read_config" and "GetLays".
LOAD.LSP the file used to load the various lisp.
CFL to run
I hope I have made ​​a decent translation

Hi smemo,
Excellent research work.
It is very useful to me.

 However, I have two requests:
 
- Do not want to create the dimstyles cfstandard, cfMeccanico and cfArchitettonico;
- Disable the frame OPTION in DCL box.

 Thanks in advance    

[smemo]

You need to comment in the file lisp lines:

Code: [Select]

953 (StiliDIM)
959 (ListaDimStili)
965 (set_tile "$CSD" "0")
966 (setq CreDimScala "0")
974 (mode_tile "$DST" 1)
983 (action_tile "$CSD" "(setq CreDimScala (get_tile \"$CSD\"))(if (= CreDimScala \"1\" )(congela)(scongela))")
990 (action_tile "$DST" "(setq DS_nlst (atoi $value))")
999 (setq DS_nlst (atoi (get_tile "$DST")))
1000 (setq StQuo (nth DS_nlst ListaDS))
1023 (if (/= CreDimScala "1")
1033 );if
1035 (if (= CreDimScala "1")
1036 (progn
1037     (command "_.-dimstyle" "_restore" StQuo)
1038 (CreaStyDim)
1039 (setvar "textsize" (/ 2.5 (distof FattZoom 2)))
1040 ;; Se è stato selezionato la creazione delle quote imposta anche l'altezza dei testi a 2.5 mm
1041     )
1042 )

and comment in the file DCL lines:

Code: [Select]

100 : toggle {
101 label = "Creates only Style DIM";
102 key = "$CSD";
103 value = "0";
104 }
105 : popup_list {
106 label = "from Style:";
107 key = "$DST";
108 width = 30 ;
109 allow_accept = false;
110 }


[luisternou]

As result of the first post about how to create a viewport in modelspace, the code listed below only works in WCS. Most off the time I'm working in a UCS. If I use this lisp in UCS it doesn't work.
Please, can someone help!!

Thanks in advance!!

Code: [Select]

(defun c:NV (/ *error* _RestoreView p1 p2 doc ct vs vc tmp mp sc ll sl res vpdoc vpp vp ans)
  (defun *error* (Msg)
    (princ "Error: ")
    (princ Msg)
    (if ct (_RestoreView))
    (princ)
  )
  (defun _RestoreView ()
    (setvar "ctab" ct)
    (vla-ZoomCenter (vlax-Get-Acad-Object) (vlax-3d-Point (trans vc 1 0)) vs)
  )
  (vl-load-com)
  (if (/= (getvar "cvport") 1)
    (if
      (and
        (setq p1 (getpoint "\nSelect first point of view: "))
        (setq p2 (getcorner p1 "\nSelect second point of view: "))
      )
      (progn
        (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
              ct (getvar "ctab")
              vs (getvar "viewsize")
              vc (getvar "viewctr")
              sc (cond
                   ( (getint
                       (strcat
                         "\nWhat is Viewport Scale 1: <"
                         (itoa (setq sc (cond (sc) (50))))
                         ">: "
                       )
                     )
                   )
                   ( sc )
                 )
        )
        (setq ll
          (vlax-for % (vla-get-layouts doc)
            (setq res
              (cons
                (list
                  (vla-get-name %)
                  %
                  (vla-get-TabOrder %)
                )
                res
              )
            )
          )
        )
        (setq ll
          (cdr
            (vl-sort ll
             '(lambda (a b)
                (< (last a) (last b))
              )
            )
          )
        )
        (if (setq sl (cd:DCL_StdListDialog (mapcar ' car ll) 0 "NewViewport" "Select layout:" 40 15 2 nil T T))
          (progn
            (setvar "ctab" (car (nth sl ll)))
            (vla-put-MSpace doc :vlax-false)
            (if (setq vpp (getpoint "\nSelect Point for Viewport: "))
              (progn
                (if
                  (<
                    (car (trans p2 1 0))
                    (car (trans p1 1 0))
                  )
                  (setq tmp p1 p1 p2 p2 tmp)
                )
                (setq mp
                  (list
                     (/ (+ (car p1) (car p2)) 2)
                     (/ (+ (cadr p1) (cadr p2)) 2)
                     0.0
                  )
                )
                (setq vpdoc (vla-get-PaperSpace doc)
                      vp (vla-AddPViewport
                           vpdoc
                           (vlax-3d-point vpp)
                           (abs (/ (- (car p2) (car p1)) sc))
                           (abs (/ (- (cadr p2) (cadr p1)) sc))
                         )
                )
                (vla-display vp :vlax-true)
                (vla-put-MSpace doc :vlax-true)
                (vla-put-ActivePViewport doc vp)
                (vla-ZoomCenter
                  (vlax-get-acad-object)
                  (vlax-3d-point mp)
                  1.0
                )
                (vla-put-CustomScale vp (/ 1. sc))
                (vla-put-MSpace doc :vlax-false)
                (vla-put-DisplayLocked vp :vlax-true)
                (initget "Yes No")
                (setq ans
                  (cond
                    ( (getkword "\nBack to model space [Yes/No] <No>: ") )
                    ( "No" )
                  )
                )
                (if (= ans "Yes") (_RestoreView))
              )
              (progn
                (princ "\n** Invalid Point ** ")
                (if ct (_RestoreView))
              )
            )
          )
          (princ "\n** Layout not selected ** ")
        )
      )
      (princ "\n** Invalid Point ** ")
    )
    (princ "\nStart Program in Model Space ")
  )
  (princ)
)
; =========================================================================================== ;
; Okno dialogowe z lista (list_box) / Dialog control with list (list_box)                     ;
;  Data      - lista do wyswietlenia / list to display                              ;
;  Pos       [INT]     - pozycja poczatkowa na liscie / select list position                  ;
;  Title     [STR/nil] - tytul okna / window title                                            ;
;  ListTitle [STR/nil] - tytul list_box / list_box title                                      ;
;  Width     [INT]     - szerokosc / width                                                    ;
;  Height    [INT]     - wysokosc / height                                                    ;
;  Btns      [0/1/2]   - [cancel/ok/ok_cancel] przyciski / buttons                            ;
;  MSelect   [T/nil]   - dopuszczenie multiple_select / allow multiple select                 ;
;  DPos      [T/nil]   - zapamietanie pozycji okna / save window position                     ;
;  DblClick  [T/nil]   - podwojny klik (wykluczone Cancel) / double click (not for Cancel)    ;
; ------------------------------------------------------------------------------------------- ;
; Zwraca / Return:                                                                            ;
;  nil  = nic nie wybrano (anulowano) / nothing was selected (canceled)                       ;
;  INT  = wybrano jedna pozycje / one position selected  | MSelect = nil                      ;
;  LIST = wybrano kilka pozycji / few positions selected | MSelect = T                        ;
; ------------------------------------------------------------------------------------------- ;
; (cd:DCL_StdListDialog '("A" "B" "C") 0 "Title" "ListTitle:" 40 15 2 nil T nil)              ;
; =========================================================================================== ;
(defun cd:DCL_StdListDialog (Data Pos Title ListTitle Width Height Btns MSelect DPos DblClk
                             / f tmp dc res)
  (if (not DPos) (setq *cd-TempDlgPosition* (list -1 -1)))
  (cond
    ( (not
        (and
          (setq f
            (open
              (setq tmp (vl-FileName-MkTemp nil nil ".dcl"))
              "w"
            )
          )
          (foreach %
            (list
              "StdListDialog:dialog{"
              (strcat "label=\""
                (if Title (strcat Title "\";") "\"\";")
              )
              ":list_box{key=\"list\";"
              (if ListTitle
                (strcat "label=\"" ListTitle "\";")""
              )
              "fixed_width=true;fixed_height=true;"
              (strcat "width="
                (if (not Width) "20" (itoa Width))";"
              )
              (strcat "height="
                (if (not Height) "20" (itoa Height))";"
              )
              (if (not DblClck)
                (strcat "multiple_select="
                  (if MSelect "true;" "false;")
                )
                "multiple_select=false;"
              )
              "}"
              (cond
                ( (zerop Btns) "cancel_button;")
                ( (= 1 Btns) "ok_only;")
                (T "ok_cancel;")
              )
              "}"
            )
            (write-line % f)
          )
          (not (close f))
          (< 0 (setq dc (load_dialog tmp)))
          (new_dialog "StdListDialog" dc ""
            (cond
              ( *cd-TempDlgPosition* )
              ( (quote (-1 -1)) )
            )
          )
        )
      )
    )
    ( T     
      (start_list "list")
      (mapcar (quote add_list) Data)
      (end_list)
      (if (not Pos)
        (setq Pos 0)
        (if (> Pos (length Data)) (setq Pos 0))
      )
      (setq res (set_tile "list" (itoa Pos)))
      (action_tile "list"
        (strcat
          "(setq res $value)(if DblClk (if(or(not MSelect)"
          "(not (zerop Btns)))"
          "(if (= $reason 4)(setq "
          "*cd-TempDlgPosition* (done_dialog 1)))))"
        )
      )
      (action_tile "accept" "(setq *cd-TempDlgPosition* (done_dialog 1))")
      (action_tile "cancel" "(setq res nil) (done_dialog 0)")
      (setq res
        (if (= 1 (start_dialog))
          (read (strcat "(" res ")"))
          nil
        )
      )         
    )
  )
  (if (< 0 dc) (unload_dialog dc))
  (if (setq tmp (findfile tmp)) (vl-File-Delete tmp))
  (if (not DPos) (setq *cd-TempDlgPosition* (list -1 -1)))
  (if res (if (= 1 (length res)) (car res) res))
)
(princ "\n Type NV to Invoke ")
(princ)


[luisternou]

Anybody? 

[luisternou]

......much appreciated!!! 

[luisternou]

....the solution is near! See topic:
http://www.theswamp.org/index.php?topic=47145.0;all
Big thanks to Roy_43!!

[luisternou]

....is there someone to help? Thanks in advance!!!! 

[kruuger]

....is there someone to help? Thanks in advance!!!! 

check this tool. also in english.
http://forum.cad.pl/viewportmaster-mened-er-rzutni-t84275.html
kruuger

[luisternou]

Thanks Kruuger for the tip! Sorry for the late respond! This could be more then I expected! 

[ahsattarian]

The Link Doesn't Work  :


 http://web2.airmail.net/terrycad/AutoLISP-Code.htm

[ahsattarian]

And This May Help U  :

Code - Auto/Visual Lisp: [Select]

1. (defun c:a ()
2.   (defun sub1 ()
3.     (setq method2 2) ;|  #zoom  |;
4.     (cond
5.       ((= method2 1) (command "zoom" p1 p2 "zoom" (strcat (rtos sc) "x")))
6.       ((= method2 2) (command "zoom" "c" pm (/ dy sc)))
7.     )
8.   )
9.   (setq fuzzy 0.0001)
10.   (setvar "tilemode" 1)
11.   (setq s (car (entsel " Select Object : ")))
12.   (redraw s 4)
13.   (setq bbox (acet-ent-geomextents s)) ;|  #bounding box  |;
14.   (setq p1 (car bbox))
15.   (setq p2 (cadr bbox))
16.   (setq pm (acet-geom-midpoint p1 p2))
17.   (setq dx (abs (- (car p2) (car p1))))
18.   (setq dy (abs (- (cadr p2) (cadr p1))))
19.   (cond ((or (equal dx 0.0 fuzzy) (equal dy 0.0 fuzzy)) (print " ERROR !! ") (exit)))
20.   (setvar "tilemode" 0)
21.   ;;(setq sc 0.9)
22.   (setq sc 1.0)
23.   (setq method1 2)
24.   (cond
25.     ((= method1 1)
26.      (command "pspace")
27.      (sub1)
28.      (setq method3 2)
29.      (cond
30.        ((= method3 1) (command "vports"))
31.        ((= method3 2) (command "mview")) ;|  #mview  |;
32.      )
33.      (command p1 p2)
34.      (command "mview" "on" "last" "")
35.      (command "mview" "lock" "off" "last" "")
36.      (command "mspace")
37.      (setvar "cvport" (cdr (assoc 69 (entget (entlast))))) ;|  #cvport  |;
38.      (sub1)
39.      (command "regen")
40.      (command "pspace")
41.      (command "mview" "lock" "on" "last" "")
42.     )
43.     ((= method1 2)
44.      (setq doc (vla-get-activedocument (vlax-get-acad-object)))
45.      (vla-put-mspace doc :vlax-false) ;|  #pspace  |;
46.      (vla-zoomcenter (vlax-get-acad-object) (vlax-3d-point pm) (/ dy sc)) ;|  #zoom  |;
47.      (setq obj (vla-addpviewport (vla-get-paperspace doc) (vlax-3d-point pm) dx dy))
48.      (vla-display obj :vlax-true)
49.      (vla-put-displaylocked obj :vlax-false)
50.      (vla-put-mspace doc :vlax-true) ;|  #mspace  |;
51.      (vla-put-activepviewport doc obj) ;|  #cvport  |;
52.      (vla-zoomcenter (vlax-get-acad-object) (vlax-3d-point pm) (/ dy sc)) ;|  #zoom  |;
53.      (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)
54.      (vla-put-mspace doc :vlax-false) ;|  #pspace  |;
55.      (vla-put-displaylocked obj :vlax-true)
56.     )
57.   )
58.   (princ)
59. )

[jtoverka]

Is there an ObjectDBX compatible alternative to using the following?

Code: [Select]

     (vla-put-mspace doc :vlax-true) ;|  #mspace  |;
     (vla-put-activepviewport doc obj) ;|  #cvport  |;
     (vla-zoomcenter (vlax-get-acad-object) (vlax-3d-point pm) (/ dy sc)) ;|  #zoom  |;

Is it really not supported (by ObjectDBX) to directly put in the coordinates of your paperspace viewport view?