;; Discussion
;; If autoCad installed in Windows 8.1 Touch-screen auto-rotate enabled
;; if the screen size 1:2 vertical, after 90 degrees rotated, would it be 2:1
;; i'm not sure does it affect the viewport or system variables vsmas, vsmin, ocs, ucs?
;; whether grread mouse click returns value, pinch zoom in-out grread or other gestures value?
;;
;; welcome to modify & guide is very appreciated ,
;; The code is very basic just for idea, i apologize if a novice's code wasting your time
;; Maybe it's a start point to create virtual mouse click or other gesture routines?
;; The function: (getvp% % ), where (% < 0), percentage of viewport being capture
;; output list of min & max coordinates (min max viewfactor )
;;
;; see example applied in defun c:TEST
;;
;;hp#003
;; get optimized viewport on SCREEN DISPLAY
(defun getvp% ( % / vmin vmax dv vpw vph vfact vH vW ); % = percentage to fit current viewport
(setq vCP (trans (getvar "viewctr") 1 2)
vmin (trans (getvar "vsmin") 1 2)
vmax (trans (getvar "vsmax") 1 2)
dv (mapcar '- vmax vmin) ; diff vmax & vmin in list (x y z)
vpw (car dv) ; viewport Width
vph (cadr dv) ; viewport Height
vfact (/ vpw vph) ; View Factor
vH (getvar "viewsize")
vW (* vH vfact)
BLx (- (car vCP) (* (/ vW 2.) (/ % 100.)))
BLy (- (cadr vCP) ( * (/ vH 2.) (/ % 100.)))
TRx (+ (car vCP) (* (/ vW 2.) (/ % 100.)))
TRy (+ (cadr vCP) ( * (/ vH 2.) (/ % 100.)))
vBL(list BLx BLy) ;
vTR(list TRx TRy) ;
)
(List vBL vTR vfact); bottom Left, Top Right, view Factor
)
; This grdraw has little bug on rotated UCS.. (trans p ?)
(defun Grbox( BL TR); grdraw Hidden Rectang, Bottom Left =BL, Top Right =TR
(grdraw BL (setq TL(list (car BL)(cadr TR )0.)) 2 1)
(grdraw TL TR 2 1)
(grdraw TR (setq BR(list (car TR )(cadr BL)0.)) 2 1)
(grdraw BR BL 2 1)
); grbox
(setvar "cmdecho" 0)
(if
(tblsearch "STYLE" "TEST")
(terpri)
(vl-cmdf "-style" "TEST" "Arial.ttf" 1 1 0
"N" "N" "N"
)
)
(defun C:Test nil
(textpage)
(princ"\nCurrent viewport checker..\nInput percentage of wish to capture... ")
(getvp% (atof (lisped "50 %"))); get 50% of current viewport
(grbox (trans vBL 2 0) (trans vTR 2 0))
(mapcar '(lambda (txt color)
(entmake (mapcar 'cons '(0 1 7 10 11 40 62 72)
(list "TEXT"
txt
"TEST"
(trans vcp 2 0)
(trans vcp 2 0)
(*(- TRy BLy) 0.2)
color
4
); list
); mapcar
);entmake
)'("SWAMP .ORG" "THE")'(2 1))
(setvar "osmode" 0)
(vl-cmdf "WIPEOUT" "F" "ON") ; optional OFF
(vl-cmdf "WIPEOUT" (trans vBL 2 1) (trans TL 2 1) (trans vTR 2 1) (trans BR 2 1) "c" " ")
(alert "Move around your mouse inside view port" )
)
;hp#003
