;|------------ 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)
Updatedif you don't mind. Probably still not perfect:
This is final release for lisp to create a viewport for selected area
Your comments are welcomeCode: [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
Updatedif you don't mind. Probably still not perfect:
...
kruuger
My routines below:Thanks for new idea
...
Initializing...
Scale list being loaded, Please be patient......
bad argument type: numberp: nil
My routines below:Thanks for new idea
...
but gives errorCode: [Select]Initializing...
Scale list being loaded, Please be patient......
bad argument type: numberp: nil
My routines below:i saw that you are using some subroutine form here: http://web2.airmail.net/terrycad/AutoLISP-Code.htm (like set_tile_list, maybe more)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)
)
Yes I included the additional routines in my zip file?My routines below:i saw that you are using some subroutine form here: http://web2.airmail.net/terrycad/AutoLISP-Code.htm (like set_tile_list, maybe more)Code - Auto/Visual Lisp: [Select]
;=============================================================================Turn off command line responses ;============================================================================= ) (c:LRG) ; moved MPL set scale to invoke in mspace only (c:MPL) ;=============================================================================Turn off command line responses ;============================================================================= )
without loading some additional function program will not work.
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?
Hello Kruuger!hmm, this is very weird.
Unfortunately I get an error message:
command:
Select Point for Viewport: Error: Automation error Invalid argument
Height in methodRegeneriert AddPViewport model.
Martin
(/ (- (car p2) (car p1)) sc)
(/ (- (cadr p2) (cadr p1)) sc)
(abs (/ (- (car p2) (car p1)) sc))
(abs (/ (- (cadr p2) (cadr p1)) sc))
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
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 )
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 }
(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)
....is there someone to help? Thanks in advance!!!! :)check this tool. also in english.
(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 |;