; Source: http://www.theswamp.org/index.php?topic=42149.msg473439#msg473439
; Improvements suggested by Lee Mac: http://www.theswamp.org/index.php?topic=42149.msg473793#msg473793
; Modified version for: http://www.theswamp.org/index.php?topic=47145
(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)
(setvar "osmode" 0)
(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
( (getreal
(strcat
"\nWhat is Viewport Scale 1: : "
)
)
)
( 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)
(vla-object (entlast)))
;;; ============================================================ End of mod.
(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" )
)
)
(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 "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))
( 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))
)
(setvar "osmode" 167)
(princ "\n Type NV to Invoke ")
(c:nv)
(princ)

Advertisements