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