Reliably Get "Display" Corners? -- Active(P)Viewport properties lag after zooming

Fundamental question: How do I get the UCS coordinates of the current
display (not necessarily vport) (,reliably)?

Much searching has not revealed the answer to me. The following code
partially works as noted inline, but I want it to work all the time. I am
partial to Version 1, but I cannot seem to figure out how to update the
object properties after a zoom operation. Any thoughts?

Okay, as I was posting it occurred to me to remove trans from Version 2 and
now it works perfectly. But I still wonder why the Active(P)Viewport does
not keep up with zooming. I tried vla-update and regen, but could not
figure out how to make it update. Any thoughts?
--
James Allen
Malicoat-Winslow Engineers, P.C.
Columbia, MO

;;; Returns the lower left and upper right corners of the current
;;; display in UCS coordinates.
(defun MWE:GetCDisplayCorners (arglst / cn doc ht invp ll mspc obj ur wd)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
mspc (if (eq (vla-get-ActiveSpace doc) acModelSpace)
t
) ;t if in model tab
invp (if (and (not mspc) (eq (vla-get-MSpace doc) :vlax-True))
t
) ;t if in pvport
)
(if invp
(vla-put-MSpace doc :vlax-False)
)
(setq obj (vlax-get doc
(if mspc
'ActiveViewport
'ActivePViewport
)
)
;; Version 2 works perfectly for Paper Space but only for Paper Space
cn (getvar "viewctr")
ht (getvar "viewsize")
wd (* ht
(apply
'/
(mapcar '(lambda (a) (vlax-get obj a)) '(Width Height))
)
)
;; End Version 2
)
;; Version 1 works initially, but lags after zooming.
;;; (mapcar '(lambda (a b) (set a (vlax-get obj b)))
;;; '(cn ht wd)
;;; '(Center Height Width)
;;; )
;; End Version 1
(mapcar
'(lambda (a b)
(set
a
;; Version 2 Well okay, now it works perfectly
(mapcar b cn (mapcar '(lambda (a) (/ a 2.0)) (list wd ht)))
;; End Version 2
;; Version 1
;;; (trans
;;; (mapcar b cn (mapcar '(lambda (a) (/ a 2.0)) (list wd ht)))
;;; 2
;;; 1
;;; )
;; End Version 1
)
)
'(ll ur)
'(- +)
)
;; Test line
(command "line" ll ur "")
(if invp
(vla-put-MSpace doc :vlax-True)
)
(list ll ur)
)

 

Hi James

Maybe you can find in this samples what you are looking for:

Code:

;AutoLISP (all AutoCAD):
(defun GetVptBoundary ( / ExLoop OffSet VptCen VptEnl VptEnt)
(while (not ExLoop)
(initget " ")
(setq VptEnt (entsel "\nSelect viewport: "))
(cond
((= VptEnt "") (not (setq ExLoop T)))
(VptEnt
(if (= (cdr (assoc 0 (entget (car VptEnt)))) "VIEWPORT")
(progn
(setq VptEnl (entget (car VptEnt))
VptCen (reverse (cdr (reverse (cdr (assoc 10 VptEnl)))))
OffSet (mapcar
'(lambda (l) (/ (cdr (assoc l VptEnl)) 2.0)) '(40 41)
)
ExLoop T
)
(list
(trans (mapcar '(lambda (c o) (- c o)) VptCen OffSet) 3 2)
(trans (mapcar '(lambda (c o) (+ c o)) VptCen OffSet) 3 2)
)
)
(prompt " selected entity is not a viewport.")
)
)
(T (prompt " 1 selected, 0 found."))
)
)
)

;Visual LISP (A2k+):
(defun VxGetVptBoundary ( / ExLoop VptCen VptEnt VptObj XofSet YofSet)
(vl-load-com)
(while (not ExLoop)
(initget " ")
(setq VptEnt (entsel "\nSelect viewport: "))
(cond
((= VptEnt "") (not (setq ExLoop T)))
(VptEnt
(setq VptObj (vlax-ename->vla-object (car VptEnt)))
(if (= (vla-get-ObjectName VptObj) "AcDbViewport")
(progn
(setq VptCen (vlax-get VptObj "Center")
XofSet (/ (vla-get-Width VptObj) 2.0)
YofSet (/ (vla-get-Height VptObj) 2.0)
ExLoop T
)
(list
(trans (list (- (car VptCen) XofSet) (- (cadr VptCen) YofSet)) 3 2)
(trans (list (+ (car VptCen) XofSet) (+ (cadr VptCen) YofSet)) 3 2)
)
)
(prompt " selected entity is not a viewport.")
)
)
(T (prompt " 1 selected, 0 found."))
)
)
)

Cheers

 

Thank you Jürg. Unfortunately though, I couldn't find the answer in your
code. However, I did discover while checking it that user-defined
pviewports apparently do not suffer the same lag problem I am seeing with
"the paper space viewport" and "the model space viewport" (my term).

Perhaps this will help illustrate the problem. If you run the following
code, it will draw a line from ll to ur of your display. If you zoom .5x
(for example) and immediately run this again, it will draw the exact same
line again, not to the new current display as it should. The problem is in
the vla-object properties, they don't update when you zoom. My question is
how to get the (updated) properties of the *current* display vla-object.

James

Code:

;;; Draws a line between the lower left and upper right corners
;;; of the current display.
(defun c:dctest (/ cn doc ht invp ll mspc obj ur wd)
(setq doc  (vla-get-ActiveDocument (vlax-get-acad-object))
mspc (if (eq (vla-get-ActiveSpace doc) acModelSpace)
t
)    ;t if in model tab
invp (if (and (not mspc) (eq (vla-get-MSpace doc) :vlax-True))
t
)    ;t if in pvport
)
(if invp
(vla-put-MSpace doc :vlax-False)
)
(if mspc
(setq obj (vla-get-ActiveViewport doc))
(setq obj (vla-get-ActivePViewport doc))
)
(setq cn (vlax-get obj 'Center)
ht (vla-get-Height obj)
wd (vla-get-Width obj)
ll (list (- (car cn) (/ wd 2.0)) (- (cadr cn) (/ ht 2.0)) 0.0)
ur (list (+ (car cn) (/ wd 2.0)) (+ (cadr cn) (/ ht 2.0)) 0.0)
ll (trans ll 2 1)
ur (trans ur 2 1)
)
(command "line" ll ur "")
(if invp
(vla-put-MSpace doc :vlax-True)
)
(list ll ur)
)