[编程交流] lisp用于自动设置vie

(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)
                          (/ (- (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
               )
               (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      
[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 "20" (itoa Width))";"
             )
             (strcat "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)