Change Base Insertion Point of Viewport

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello,
I am new to creating AutoCAD LISPs. I found the lisp below to help create viewports in paper space from limits set in model space. I would like to have the basepoint of the viewport be the Top-right corner when I insert it into paper space, instead of being centered as it is now.
I am using this to create windows in paper space that focus on a particular rows of a master table. (cable schedule) I can then select the rows of cables I want to be shown in Paper Space.
Note: When using LISP below, First point must be bottom-right corner, and second point must be top-left or it won't work.
Thanks,
Paul
(defun c:NV (/ *error* _RestoreView p1 p2 doc ct vs vc tmp mp sc ll 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) (1))))
">: "
)
)
)
( sc )
)
)
(setq ll
(vlax-for % (vla-get-layouts doc)
(setq res
(cons
(list
%
(vla-get-TabOrder %)
)
res
)
)
)
)
(vla-put-ActiveLayout doc
(caar
(vl-sort ll
'(lambda (a b)
(> (cadr a) (cadr b))
)
)
)
)
(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** Invalid Point ** ")
)
(princ "\nStart Program in Model Space ")
)
(princ)
)
(princ "\n Type NV to Invoke ")
(princ)