TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: linhoreka on March 20, 2011, 11:36:45 AM

Title: Lisp to rotate MViewport: both the boundary & the view-twist-angle rotate too !
Post by: linhoreka on March 20, 2011, 11:36:45 AM
In Vietnam, almost drafters don't use paper space. We usually to draw all in model space ! So may be this is an useful routines for drafters outside Vietnam

This routine i made in 2008. Because rotating a viewport in paper space need too many mouse and keyboard clicks, i tried to change it, make it as easy as rotating any other object.
So, here it is, the command is C:MR http://www.mediafire.com/?bz68b2upbr8yv8j (http://www.mediafire.com/?bz68b2upbr8yv8j)

Another command included is C:MSC which would scale both the boundary and the view scale of the MViewport. The basepoint is the center of the MViewport. This command is made since AutoCAD 14 !  Now with new AutoCAD version, we can do this with the Scale dropdown list. But i thought it is still useful, because it is different !

I don't know much about the enhancements in AutoCAD recently. May be there is some other better commands to rotate and scale a MViewport ? Anyway, I've made it myself
Title: Re: Lisp to rotate MViewport: both the boundary & the view-twist-angle rotate too !
Post by: CAB on March 20, 2011, 05:25:41 PM
Welcome to the Swamp & thank you for sharing. 8-)

FYI, Some folks here will not run compiled code because of the potential for harm.
Title: Re: Lisp to rotate MViewport: both the boundary & the view-twist-angle rotate too !
Post by: linhoreka on March 20, 2011, 06:53:50 PM
Here is the Lisp original:
Code: [Select]
(defun C:MSC (/ beep vp vpl cen msh psh vid zxp newzxp sc result vpline);MView setup scale
  (begin)
 
  (setq beep "b")
  (while beep
    (setq result (getviewport nil))
    (if (null result)(exit))
    (setq vp (car result)
  vpline (caddr result)
  );setq
   
    ;(setq vp (car (entsel)))   
    (if vp
      (progn
(setq vpl (entget vp))
(setq label (cdr (assoc 0 vpl))
      pointer (cdr (assoc 330 vpl)))
        (cond ((equal label "VIEWPORT") (setq beep nil))
      (pointer
      (progn
       (setq vpl (entget pointer)
             label (cdr (assoc 0 vpl)))
       (if (equal label "VIEWPORT") (setq beep nil)
(prompt "\nlinhoreka - 7cad.wordpress.com : The selected object isn't a Viewport! Select a Viewport ..."))
       ))
         
)
       )
      )
     );while
  (setq cen (assoc 10 vpl)
psh (assoc 41 vpl)
msh (assoc 45 vpl)
vid (assoc 69 vpl)
cen (list (cadr cen) (caddr cen))
psh (cdr psh)
msh (cdr msh)
zxp (/ msh psh)
vid (cdr vid)
)
  (command ".mview" "lock" "off" vp "")
  (prompt (strcat "linhoreka - 7cad.wordpress.com: Current Viewport scale : 1 :" (rtos zxp) "\n"))
  ;(initget 7 "Esc")
  (setq newzxp (getreal "Enter new Viewport Scale : 1: "))
  (if newzxp
    (progn
      (setq sc (/ 1. newzxp))
      ;(end)(exit)
      ;(setvar "CVport" vid)
      (command ".mspace" )(setvar "cvport" vid)
      (command ".zoom" (strcat (rtos sc 2 8) "XP") ".pspace")     
      (command ".scale" vp vpline "" cen (* zxp sc))
      )
    (prompt "\nFunction Cancel")
    );if
 
  (command ".mview" "lock" "on" vp "") 
  (end)
  (princ)
  );defun C:MVSC

;No more VBA - 3rd September 2010
;
(defun C:MR (/ result mv pline mvel twistangle angle1 angle2 rotationangle
      vpid mvtarget twistcenterpoint rotationangle basepoint oldpline
      point flag)
  (begin)
  (setq flag t)
  (while flag
    (setq result (getviewport T))
    (if (null result)(exit))
    (setq mv (car result)
  pline (cadr result)
  oldpline (caddr result)
  );setq
    (if (not(null mv))(setq flag nil))
    );while

 
  (setq mvel(entget mv)
twistangle (cdr(assoc 51 mvel))
);setq
  ;twist the mview around the view target point dxf code = 17 WCS
  (setq mvtarget (cdr(assoc 17 mvel))
    vpid (cdr(assoc 69 mvel))
    );setq
  (setq angle1 (plineangle pline))
  (command ".mspace")(setvar "Cvport" vpid)
  (setq twistcenterpoint (trans (trans mvtarget 0 2) 2 3))
  (command ".pspace")
  (command ".point" twistcenterpoint)
  (setq point (entlast))
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setvar "cmdecho" 1)
  (command ".Rotate" pline point "")
  (while (/= 0 (getvar "cmdactive"))(command pause))
  (setvar "cmdecho" 0)
  (setq basepoint (cdr(assoc 10 (entget point))))
  (entdel point)
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq angle2 (plineangle pline))
  ;rotate the polyline associated with the mview
  ;then, get the rotation angle
  (setq rotationAngle (- angle2 angle1)
twistAngle (+ twistangle rotationAngle)
)
  (if (/= rotationangle 0)
    (progn
      (settwistangle mv twistangle)
      (command ".move" pline "" basepoint twistcenterpoint)
      (command ".vpclip" mv pline)
      (command ".move"  pline "" twistcenterpoint basepoint)
      ;delete the previous clip ?
      (if (not (null oldpline)) (entdel oldpline))
      );progn
    (entdel pline);else
    );if 
  (princ)
  (end)
  ;linhoreka Tuesday Feb 3rd 2009
  );defun

;-----------------------------------------------------------------
(defun twistview (angle /)
  (command "dview" "" "twist" angle "")
  )

(defun GetClipEntityHandle (pViewportHandle / pviewport pvlist clipent ClipHandle)
  ;assume that the pviewport is clipped. if it is not, >> the VBA can deal with it 
  (setq Pviewport (handent PviewportHandle))
  (setq pvlist (entget pviewport)
clipent (cdr(assoc 340 pvlist))
)
  (if (null clipent)
    (setq ClipHandle "")
    (setq ClipHandle (cdr (assoc 5 (entget clipent))))
    );if   
  );defun
(defun GetPviewportHandle (plinehandle / pline plist vpent vlist label oldpline PViewportHandle)
  (setq pline (handent plinehandle))
  (setq plist (entget pline)
vpent (cdr(assoc 330 plist))
vlist (entget vpent)
label (cdr(assoc 0 vlist))
)
  (if (= label "VIEWPORT")   
      (setq PViewportHandle (cdr(assoc 5 vlist)))
      (setq PViewportHandle "")
    );if
 
  );defun

(defun GetViewport (createPline / label ent el pline)
  (setvar "tilemode" 0)
  (command ".pspace")
  (prompt "linhoreka - 7cad.wordpress.com - Select a viewport: ")
  (setq ent (car(entsel)))
  (if (null ent)(exit));
       
  (setq el (entget ent)
label (cdr(assoc 0 el))
)
  (if (= label "VIEWPORT")
    (if createPline
      (progn
      ;create pline from mv entity
      (setq mvcenter (cdr(assoc 10 el))
    xcenter (car mvcenter)
    ycenter (cadr mvcenter)
    halfheight (/ (cdr(assoc 41 el)) 2)
    halfwidth (/ (cdr(assoc 40 el)) 2)
    );setq
     
      (setq plineElist (list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
;(cons 67 1)
;(cons 410 "S001")
(cons 100 "AcDbPolyline")
(cons 8 "0")
(cons 90 4)(cons 70 1)(cons 43 0.)(cons 38 0.)(cons 39 0.)
(cons 10 (list (- xcenter halfwidth)(- ycenter halfheight)))
(cons 40 0.)(cons 41 0.)(cons 42 0.)
(cons 10 (list (- xcenter halfwidth)(+ ycenter halfheight)))
(cons 40 0.)(cons 41 0.)(cons 42 0.)
(cons 10 (list (+ xcenter halfwidth)(+ ycenter halfheight)))
(cons 40 0.)(cons 41 0.)(cons 42 0.)
(cons 10 (list (+ xcenter halfwidth)(- ycenter halfheight)))
(cons 40 0.)(cons 41 0.)(cons 42 0.)
;(cons 210 '(0. 0. 1.))
);list
    );setq
      (entmake plineelist)
      (setq pline (entlast))     
      );progn 1
      );if createpline
    (progn
      (setq oldpline ent)
      (setq ent (handent (GetPviewportHandle (cdr(assoc 5 el)))))
      (if createPline
(if (null ent)(setq pline nil)
(progn
  (entmake el)
  (setq pline (entlast));create new pline  
  )
);if
);if createPline
      );progn 2
    );if label = viewport
  ;));(if (not(null ent))(progn;
   
  (list ent pline oldpline)
  );defun

(defun SetTwistAngle (mv twistangle / vlaMv) 
   (vl-load-com)
  (setq vlaMv (vlax-ename->vla-object mv))
  (vlax-put-property vlaMv "TwistAngle" twistangle)
  ;(vl-vbarun  "SetTwistAngle");can it get the local variable ? 
  )


(defun PlineAngle (pline / allvertices plel v1 v2);private function
  (setq plel (entget pline)
allvertices (assoc_all 10 plel)
v1 (car allvertices)
v2 (cadr allvertices)

  (angle v1 v2)
  );defun




; COMMONS ROUTINES
(defun begin (/)
 
  (init_bonus_error
 (list
   (list "cmdecho" 0
         "expert" 0
   )
 T    ;Flag
 )
);init bonus error
  ;(setvar "cmdecho" 1)
  (setvar "osnapcoord" 1)
  (setvar "cmdecho" 0)
  (command "UCS" "W") 
 
);

(defun end (/)
  (command "UCS" "P")
  (restore_old_error)
  (prompt "\nThank you for using my routines ^^ linhoreka - 7cad.wordpress.com")
  (princ)
  )



;----------------------------------------------------------------------
(defun whilecmdactive ()
  (setvar "cmdecho" 1)
  (while (> (getvar "cmdactive") 0) (command pause))
  (setvar "cmdecho" 0)
  );defun whilecmdactive
(defun app (motherlist el /)
(append motherlist (list el))
)
(defun nequal (e1 e2 /)
(not (equal e1 e2))
)
(defun assoc_all (code entl / licode el)
  (setq licode (list))
  (foreach el entl
    (if
      (= (car el) code)
      (setq licode (append licode (list (cdr el))))
      );if
    );foreach
  ! licode
  )







;ERROR HANDLING
(defun init_bonus_error ( lst / ss undo_init)
 
  ;;;;;;;local function;;;;;;;;;;;;;;;;;;;;
  (defun undo_init ( / undo_ctl)
   (b_set_sysvars (list "cmdecho" 0))
   (setq undo_ctl (getvar "undoctl"))
   (if (equal 0 (getvar "UNDOCTL")) ;Make sure undo is fully enabled.
       (command "_.undo" "_all")
   )
   (if (or (not (equal 1 (logand 1 (getvar "UNDOCTL")))) 
           (equal 2 (logand 2 (getvar "UNDOCTL")))
       );or
       (command "_.undo" "_control" "_all")
   )
   
   ;Ensure undo auto is off
   (if (equal 4 (logand 4 (getvar "undoctl")))
       (command "_.undo" "_Auto" "_off")
   )
   
   ;Place an end mark down if needed.
   (while (equal 8 (logand 8 (getvar "undoctl")))
        (command "_.undo" "_end")
   );while         
   (while (not (equal 8 (logand 8 (getvar "undoctl"))))
    (command "_.undo" "_begin")                 
   );while
   (b_restore_sysvars)
   ;return original value of undoctl
   undo_ctl
  );defun undo_init

    ;;;;;;;;;;;;;begin the work of init_bonus error;;;;;;;;;;;;;
 (setq ss (ssgetfirst))
 (if (not bonus_alive)
     (setq bonus_alive 0)
 );if
 (setq bonus_alive (1+ bonus_alive))
 
 (if (and (> bonus_alive 1)                              ;do some double checking to make sure
          (or (not (equal 'LIST (type *error*)))         ;our error handler is still active.
              (not (equal "bonus_error" (cadr *error*))) ;for nested this call.
          );or
     );and
     (progn
      (princ "\nNested Error trapping is being used incorrectly.")
      (princ "\nResetting the nested index to 1.")
      (setq     *error* bonus_error
            bonus_alive 0
      );setq
      (restore_old_error);quietly restore undo status
      (setq bonus_alive 1)
     );progn then things need to be re-adjusted.
 );if
 (if (<= bonus_alive 0)   
     (progn
      (setq bonus_alive 0);undo settings will be restored
                          ;along with setting *error* back to bonus_old_error.
                          ;No call to b_restore_sysvars will be made.
                          ;If it is decided, this thing should do variable clean
                          ;up also then set bonus_alive to 1 before calling
                          ;restore_old_error
      (restore_old_error);quietly restore bonus_old_error and undo status.
      (setq bonus_alive 1)
     );progn then
 );if
 (if (= bonus_alive 1)
     (progn
      (if (and *error*
               (or (not (equal 'LIST (type *error*)))
                   (not (equal "bonus_error" (cadr *error*)))
               );or
          );and
          (setq bonus_old_error *error*);save the *error* only if it
                                        ;looks like the standard one or is some other
                                        ;user defined one. Don't want to save it if
                                        ;it's ours because we already have it.
      );if
      (if (cadr lst)
          (setq bonus_undoctl (undo_init))
          (setq bonus_undoctl nil)
      );if
    );progn then this is a top level call, or in other words, the first time through.
 );if
 (b_set_sysvars (car lst))
 (if (= bonus_alive 1)
     (progn
      (setq *error* bonus_error);setq
      (if (caddr lst)
          (setq *error* (append (reverse (cdr (reverse *error*)))
                                (list (caddr lst)
                                      (last *error*)
                                );list
                        );append
          );setq ;then add additional routine name to the error function.
      );if
     );progn
     (progn
      (if (and (> bonus_alive 1)
               (or (not (equal 'LIST (type *error*)))
                   (not (equal "bonus_error" (cadr *error*)))
               );or
          );and
          (setq *error* bonus_error);setq
      );if
     );progn else double check to make sure the bonus_error is in effect.
 );if
 (if (and ss
          (equal 1 (logand 1 (getvar "pickfirst")))
     );and
     (sssetfirst (car ss) (cadr ss))
 );if
);defun init_bonus_error

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun bonus_error ( msg / )

"bonus_error"

(setq bonus_alive -1)
(print msg)

;;Get out of any active command.
(while (not (equal (getvar "cmdnames") "")) (command nil))

;If undo global variable flag is set then use undo as a cleanup helper.
(if bonus_undoctl
    (progn
     (setvar "cmdecho" 0)

     (while (not (wcmatch (getvar "cmdnames") "*UNDO*"))
            (command "_.undo")
     );while
     (command "_end")  ;The routine that just failed created an undo
                       ;begin mark, so we need to close it off with
                       ;and "end" mark.

     (command "_.undo" "1")   ;now back up to the begining.
     (while (not (equal (getvar "cmdnames") ""))
      (command nil)
     );while

    );progn
);if

(b_restore_sysvars)
(b_restore_undo)

;Restore original error handler
(if bonus_old_error
    (setq *error* bonus_old_error)
);if

(setq bonus_alive 0)

(princ)
);defun bonus_error

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Restore_old_error
;This function should be the last thing called in a lisp
;defined command. It does a (princ) at the end for a quiet
;finish.
(defun restore_old_error ( / )

(setq bonus_alive (- bonus_alive 1))
(if (>= bonus_alive 0)
    (b_restore_sysvars)
    (setq bonus_varlist nil)
);if
(if (<= bonus_alive 0)
    (progn
     (b_restore_undo)
     (if bonus_old_error
         (setq *error* bonus_old_error);put the old error routine back.
     );if
    );progn then
);if

(princ)
);defun restore_old_error



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun b_restore_undo ()

(if bonus_undoctl
    (progn
      (b_set_sysvars (list "cmdecho" 0))

      (while (equal 8 (logand 8 (getvar "undoctl")))
         (command "_.undo" "_end")
      );while

      (if (not (equal bonus_undoctl (getvar "undoctl")))
          (progn
           (cond
            ((equal 0 bonus_undoctl)
             (command "_.undo" "_control" "_none")
            )
            ((equal 2 (logand 2 bonus_undoctl))
             (command "_.undo" "_control" "_one")
            )
           );;cond
           (if (equal 4 (logand 4 bonus_undoctl))
               (command "_.undo" "_auto" "_on")
           );if

         );progn then restore undoctl to the status the user had it set to.
      );if
      (if (not (equal 2 (logand 2 (getvar "undoctl"))))
          (b_restore_sysvars)
      );if
    );progn then restore undo to it's original setting
);if
(setq bonus_undoctl nil)

);defun b_restore_undo


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;This has no error checking. You must
;provide a list of even length in the
;following form
;( "sysvar1" value
;  "sysvar2" value2
;)
(defun b_set_sysvars (lst / lst2 lst3 a b n)

(setq lst3 (car bonus_varlist));setq

(setq n 0)
(repeat (/ (length lst) 2)
 (setq a (strcase (nth n lst))
       b (nth (+ n 1) lst)
 );setq
 (setq lst2 (append lst2
                    (list (list a (getvar a)))
            );append
 );setq
 (if (and bonus_varlist
          (not (assoc a lst3))
     );and
     (setq lst3 (append lst3
                        (list (list a (getvar a)))
                );append
     );setq
 );if

 (setvar a b)

(setq n (+ n 2));setq
);repeat
(if bonus_varlist
    (setq bonus_varlist (append (list lst3)
                                (cdr bonus_varlist)
                                (list lst2)
                        );append
    );setq
    (setq bonus_varlist (list lst2))
);if
);defun b_set_sysvars

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun b_restore_sysvars ( / lst n a b)

 (if (<= bonus_alive 0)
     (setq           lst (car bonus_varlist)
           bonus_varlist (list lst)
     );setq
     (setq lst (last bonus_varlist))
 );if

 (setq n 0);setq
 (repeat (length lst)
 (setq a (nth n lst)
       b (cadr a)
       a (car a)
 )
 (setvar a b)
 (setq n (+ n 1));setq
 );repeat
 (setq bonus_varlist (reverse (cdr (reverse bonus_varlist))))

);defun b_restore_sysvars