Help to modify routine lsp viewports...

[leonucadomi]

hello :

I found a good routine that I really like but I would like it to skip the last two steps.

select areas in the model space and create the same number of viewports in the paperspace

I want that when the viewports are finished being created, the routine ends and it no longer asks me if I want to return to the model or if I want to make more viewports.

 

some help please.

here code:

; NVM creates mspace vports
; Modified:
; 1. Vport layout placement is at lower left corner
; 2. Default setting to switch back to Model vs staying in Layout
; 3. Layout selection defaults to previous selection
; 4. Offers option to select multiple Model views
; 5. Offers dialog selection on scales based on ScalelistEdit
; 6. NVM loops until Esc or Enter during first point of view selection
; OP:
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-to-create-multiple-viewport/m-p/12728443#M464938
(defun c:NVM 
  (/ *error* _RestoreView _GetScaleProp 
     ans count ct doc ll vpscl vpsclp mp 
     p1 p2 ptlst res sc sci scitmp sl tmp vc vp vpdoc vpp vs
  )
  (vl-load-com)
  (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)
  )
; _GetScaleProp returns list of scalelist name assoc with paper units & drawing units
; modified from:
; https://forums.augi.com/showthread.php?107333-Using-vlisp-to-access-scales-list
(defun _GetScaleProp (/ csobj ent entnm index scaleDict scaleDictName scaleObject scllst sclnam unidwg unippr)
  (setq scaleDict (dictsearch (namedobjdict) "ACAD_SCALELIST"))
  (setq scaleDictName (cdar scaleDict))
  (setq csobj (vlax-ename->vla-object scaleDictName))
  (setq index 0)
  (repeat (vla-get-count csobj) ; loop through all scalelist names
    (setq scaleObject (vlax-invoke-method csobj 'item index))
    (setq entnm (vlax-vla-object->ename scaleObject)) ; convert from obj to entity
    (setq ent (entget entnm)) ; get entity data
    (setq sclnam (cdr(assoc 300 ent)) ; scalelist name car itm
        unippr (cdr(assoc 140 ent)) ; paper units cadr itm
        unidwg (cdr(assoc 141 ent)) ; drawing units caddr itm
        scllst (append (list(cons sclnam (list unippr unidwg))) scllst)
        index (+ index 1)
    )
  ) ; repeat
 (setq scllst (append scllst (list (list "User" 1.0 1.0)))) ; add user scale 
 (reverse scllst)
) 
;
  (if (/= (getvar "cvport") 1)
; add    
   (progn
    (setq 
      ; set Model defaults
         doc (vla-get-ActiveDocument (vlax-get-acad-object))
          ct (getvar "ctab")
          vs (getvar "viewsize")
          vc (getvar "viewctr")
      ; start loop
          p1 T
          count 0 ; view count
     vpsclp (_GetScaleProp)        ; get scalelist property
      vpscl (mapcar '(lambda (x) (car x)) vpsclp) ; create list of just first item in assoc pair for list box
          ll ; build layout list
           (vlax-for % (vla-get-layouts doc)
            (setq res
              (cons
                (list
                  (vla-get-name %)
                  %
                  (vla-get-TabOrder %)
                )
                res
              )
            )
          )
         ll
          (cdr
            (vl-sort ll
             '(lambda (a b)
                (< (last a) (last b))
              )
            )
          )
    ) ; setq
; start loop     
    (while p1
     (setq ptlst '() count 0) ; reset count & layout list
     (while p1
;         
      (if
       (and
        (setq p1 (getpoint "\nSelect first point of view or Enter to Exit: "))
        (setq p2 (getcorner p1 "\nSelect second point of view: "))
       )
       (progn
; build list of view points
        (setq ptlst (append ptlst (list (cons p1 (list p2)))))
; show # of views selected
        (if(zerop count)
         (princ (strcat "\n" (itoa (setq count (1+ count))) " View Selected...")) 
         (princ (strcat "\n" (itoa (setq count (1+ count))) " Views Selected...")) 
        )
       )
      ) ; if
     ) ; while
   
    (if ptlst  ; if list of view points
     (progn
;
      (princ (strcat"\n" (itoa (length ptlst)) " Views Selected..."))
; add scale selection dialog
      (if(not sci)
        (if (not(setq sci (vl-position "1:50" vpscl))) ; select 1:50 as default
         (setq sci 1) ; else set 2nd item as default
        )
      )
      (if (setq scitmp (cd:DCL_StdListDialog vpscl sci "Viewport Scale" "Select Scale:" 40 15 2 nil T T))  
        (if (eq "User" (nth scitmp vpscl))(setq scitmp nil)(setq sci scitmp))
      )
      (if scitmp
; then get scale = 3rd item in the prop list
        (setq sc (fix(caddr(nth sci vpsclp))))  
; else type in scale
        (setq sc (cond
                   ( (getint
                       (strcat
                         "\nWhat is Viewport Scale 1: <"
                         (itoa (setq sc (cond (sc) (50))))
                         ">: "
                       )
                     )
                   )
                   ( sc )
                 )
        )
      ) ; if
; add highlight of previous layout item selection
        (if(not sl)(setq sl 0))
        (if (setq sl (cd:DCL_StdListDialog (mapcar ' car ll) sl "NewViewport" "Select layout:" 40 15 2 nil T T))  
;          
          (progn
            (setvar "ctab" (car (nth sl ll)))
            (vla-put-MSpace doc :vlax-false)
; cycle through all selected view points
           (setq count 1)
           (foreach itm ptlst
            (setq p1 (car itm)
                  p2 (cadr itm)
            )
;
            (if (setq vpp (getpoint (strcat "\nSelect Point for " (itoa count) " of " (itoa (length ptlst)) " Viewports: ")))
              (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
; move vport so placement point is at lower left corner
;                           (vlax-3d-point vpp)
                           (vlax-3d-point 
                              (list 
                                (+ (car vpp) (/ (abs (/ (- (car p2) (car p1)) sc)) 2) )
                                (+ (cadr vpp)(/ (abs (/ (- (cadr p2) (cadr p1)) sc)) 2) )
                                0.0
                              )
                           )
;                           
                           (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)
              )
              (progn
                (princ "\n** Invalid Point ** ")
                (if ct (_RestoreView))
              )
            )
;
            (setq count (1+ count))
           ) ; foreach
;
          ) ; progn
          (princ "\n** Layout not selected ** ")
        )
; set default
                (if(not *ans*)(setq *ans* "Yes"))
;                
                (initget "Yes No")
                (setq ans
                  (cond
;                    ( (getkword "\nBack to model space [Yes/No] <No>: ") )
                    ( (getkword (strcat "\nBack to model space [Yes/No] <" *ans* ">: ")) )
                     ( *ans* )
;                    ( "No" )
                  )
                )
; reset default                
                (setq *ans* ans)
;
                (if (= ans "Yes") (_RestoreView))
;
      ) ; progn ptlist
      (princ "\n** Invalid Point ** ")
     ) ; if
;       
    ) ; while
  ) ; progn
; add loop end
    (princ "\nStart Program in Model Space ")
  )
  (princ)
) ; defun NVM
; =========================================================================================== ;
; Okno dialogowe z lista (list_box) / Dialog control with list (list_box)                     ;
;  Data      [list]    - 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 NVM to Invoke ")
(princ)

thanks

[mhupp]

I have a simpler version kicking around at home that ill post later tonight.

[leonucadomi]

29 minutes ago, mhupp said:

I have a simpler version kicking around at home that ill post later tonight.

THANKS MASTER