Visual LISP, AutoLISP and General Customization

Visual LISP, AutoLISP and General Customization

Reply
Distinguished Contributor
msarqui
Posts: 136
Registered: ‎09-14-2010
Message 1 of 9 (703 Views)
Accepted Solution

Outline projection all viewports to model

703 Views, 8 Replies
12-07-2011 08:30 PM

Hey guys!
Is there a lisp for automatically draw a pline in model space of the projection of all existing paper space viewports, without need to select one by one?
It will be also interesting if the lisp automatically create a specific layer like "ProjectViewport" to draw this plines.
I am working with autocad 2009.
Thanks for your help!

This works for me... (thanks to gile for the transformation routine)

 

(defun c:VPO (/ _trans _cornersFromBBox ss i ent data ent2 lst)
;; Viewport Outline
;; Require subroutine: PCS2WCS (and all subs it requires)
;; PCS2WCS by gile (http://www.theswamp.org/index.php?topic=29231.msg347755#msg347755)
;; Alan J. Thompson, 12.08.11

(vl-load-com)

  (defun _trans (p) (cons 10 (PCS2WCS p ent))) (defun _cornersFromBBox (o / a b) (vla-getboundingbox o 'a 'b) (setq a (_trans (vlax-safearray->list a)) b (_trans (vlax-safearray->list b)) ) (list a (list (car a) (cadr a) (caddr b)) b (list (car b) (cadr b) (caddr a))) ) (if (setq ss (ssget '((0 . "VIEWPORT")))) (repeat (setq i (sslength ss)) (setq ent (ssname ss (setq i (1- i))) data (entget ent) ) (if (if (setq ent2 (cdr (assoc 340 data))) (setq lst (apply 'append (mapcar '(lambda (x) (if (eq (car x) 10) (list (_trans (cdr x))) ) ) (entget ent2) ) ) ) (setq lst (_cornersFromBBox (vlax-ename->vla-object ent))) ) (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)) '(70 . 1) '(410 . "Model") ) lst ) ) ) ) ) (princ) ) ;; WCS2PCS (gile) ;; Translates a point WCS coordinates to the PaperSpace CS according to ;; the specified Viewport ;; ;; (WCS2PCS pt vp) is the same as (trans (trans pt 0 2) 2 3) when vp is active ;; ;; Arguments ;; pt : a point ;; vp : the viewport (ename or vla-object) (defun WCS2PCS (pt vp / elst ang nor scl mat) (vl-load-com) (and (= (type vp) 'VLA-OBJECT) (setq vp (vlax-vla-object->ename vp)) ) (setq pt (trans pt 0 0) elst (entget vp) ang (cdr (assoc 51 elst)) nor (cdr (assoc 16 elst)) scl (/ (cdr (assoc 41 elst)) (cdr (assoc 45 elst))) mat (mxm (list (list (cos ang) (- (sin ang)) 0.0) (list (sin ang) (cos ang) 0.0) '(0.0 0.0 1.0) ) (mapcar (function (lambda (v) (trans v nor 0 T))) '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)) ) ) ) (mapcar '+ (vxs (mxv mat (mapcar '- pt (cdr (assoc 17 elst)))) scl) (vxs (cdr (assoc 12 elst)) (- scl)) (cdr (assoc 10 elst)) ) ) ;; PCS2WCS (gile) ;; Translates a point PaperSpace coordinates to WCS coordinates ;; according to the specified viewport ;; ;; (PCS2WCS pt vp) is the same as (trans (trans pt 3 2) 2 0) when vp is active ;; ;; Arguments ;; pt : a point ;; vp : the viewport (ename or vla-object) (defun PCS2WCS (pt vp / ang nor scl mat) (vl-load-com) (and (= (type vp) 'VLA-OBJECT) (setq vp (vlax-vla-object->ename vp)) ) (setq pt (trans pt 0 0) elst (entget vp) ang (- (cdr (assoc 51 elst))) nor (cdr (assoc 16 elst)) scl (/ (cdr (assoc 45 elst)) (cdr (assoc 41 elst))) mat (mxm (mapcar (function (lambda (v) (trans v 0 nor T))) '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)) ) (list (list (cos ang) (- (sin ang)) 0.0) (list (sin ang) (cos ang) 0.0) '(0.0 0.0 1.0) ) ) ) (mapcar '+ (mxv mat (mapcar '+ (vxs pt scl) (vxs (cdr (assoc 10 elst)) (- scl)) (cdr (assoc 12 elst)) ) ) (cdr (assoc 17 elst)) ) ) ;; VXS Multiply a vector by a scalar ;; ;; Arguments : a vector and a real (defun vxs (v s) (mapcar (function (lambda (x) (* x s))) v)) ;; VXV (gile) ;; Returns the dot product of two vectors (real) ;; ;; Arguments : two vectors ;; return : a real number (defun vxv (v1 v2) (apply '+ (mapcar '* v1 v2))) ;; TRP ;; transposes a matrix -Doug Wilson- ;; ;; Argument : a matrix ;; return : a matrix (defun trp (m) (apply 'mapcar (cons 'list m))) ;; MXV ;; Applies a transformation matrix to a vector -Vladimir Nesterovsky- ;; ;; Arguments : une matrice et un vecteur ;; return : a vector (defun mxv (m v) (mapcar '(lambda (r) (vxv r v)) m) ) ;; MXM ;; Multiplies (combinates) two matrices -Vladimir Nesterovsky- ;; ;; Arguments : deux matrices ;; return : a matrix (defun mxm (m q) (mapcar '(lambda (r) (mxv (trp q) r)) m) )

 

Distinguished Mentor
_Tharwat
Posts: 636
Registered: ‎07-02-2010
Message 2 of 9 (702 Views)

Re: Outline projection all viewports to model

12-07-2011 08:38 PM in reply to: msarqui

Hi .

 

May I ask what do you mean by project viewport ?

____________________________________________________
Get learn and learn and practice , to become experienced guy .
Distinguished Contributor
msarqui
Posts: 136
Registered: ‎09-14-2010
Message 3 of 9 (700 Views)

Re: Outline projection all viewports to model

12-07-2011 08:58 PM in reply to: _Tharwat

I mean to create a pline in modelspace that has the outline of all viewports in the drawing.
Something like the attached lisp, but automaticaly in "one shot".

 

Valued Mentor
alanjt_
Posts: 483
Registered: ‎08-25-2008
Message 4 of 9 (677 Views)

Re: Outline projection all viewports to model

12-08-2011 11:46 AM in reply to: msarqui

This works for me... (thanks to gile for the transformation routine)

 

(defun c:VPO (/ _trans _cornersFromBBox ss i ent data ent2 lst)
  ;; Viewport Outline
  ;; Require subroutine: PCS2WCS (and all subs it requires)
  ;; PCS2WCS by gile (http://www.theswamp.org/index.php?topic=29231.msg347755#msg347755)
  ;; Alan J. Thompson, 12.08.11

(vl-load-com)

  (defun _trans (p) (cons 10 (PCS2WCS p ent))) (defun _cornersFromBBox (o / a b) (vla-getboundingbox o 'a 'b) (setq a (_trans (vlax-safearray->list a)) b (_trans (vlax-safearray->list b)) ) (list a (list (car a) (cadr a) (caddr b)) b (list (car b) (cadr b) (caddr a))) ) (if (setq ss (ssget '((0 . "VIEWPORT")))) (repeat (setq i (sslength ss)) (setq ent (ssname ss (setq i (1- i))) data (entget ent) ) (if (if (setq ent2 (cdr (assoc 340 data))) (setq lst (apply 'append (mapcar '(lambda (x) (if (eq (car x) 10) (list (_trans (cdr x))) ) ) (entget ent2) ) ) ) (setq lst (_cornersFromBBox (vlax-ename->vla-object ent))) ) (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)) '(70 . 1) '(410 . "Model") ) lst ) ) ) ) ) (princ) ) ;; WCS2PCS (gile) ;; Translates a point WCS coordinates to the PaperSpace CS according to ;; the specified Viewport ;; ;; (WCS2PCS pt vp) is the same as (trans (trans pt 0 2) 2 3) when vp is active ;; ;; Arguments ;; pt : a point ;; vp : the viewport (ename or vla-object) (defun WCS2PCS (pt vp / elst ang nor scl mat) (vl-load-com) (and (= (type vp) 'VLA-OBJECT) (setq vp (vlax-vla-object->ename vp)) ) (setq pt (trans pt 0 0) elst (entget vp) ang (cdr (assoc 51 elst)) nor (cdr (assoc 16 elst)) scl (/ (cdr (assoc 41 elst)) (cdr (assoc 45 elst))) mat (mxm (list (list (cos ang) (- (sin ang)) 0.0) (list (sin ang) (cos ang) 0.0) '(0.0 0.0 1.0) ) (mapcar (function (lambda (v) (trans v nor 0 T))) '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)) ) ) ) (mapcar '+ (vxs (mxv mat (mapcar '- pt (cdr (assoc 17 elst)))) scl) (vxs (cdr (assoc 12 elst)) (- scl)) (cdr (assoc 10 elst)) ) ) ;; PCS2WCS (gile) ;; Translates a point PaperSpace coordinates to WCS coordinates ;; according to the specified viewport ;; ;; (PCS2WCS pt vp) is the same as (trans (trans pt 3 2) 2 0) when vp is active ;; ;; Arguments ;; pt : a point ;; vp : the viewport (ename or vla-object) (defun PCS2WCS (pt vp / ang nor scl mat) (vl-load-com) (and (= (type vp) 'VLA-OBJECT) (setq vp (vlax-vla-object->ename vp)) ) (setq pt (trans pt 0 0) elst (entget vp) ang (- (cdr (assoc 51 elst))) nor (cdr (assoc 16 elst)) scl (/ (cdr (assoc 45 elst)) (cdr (assoc 41 elst))) mat (mxm (mapcar (function (lambda (v) (trans v 0 nor T))) '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)) ) (list (list (cos ang) (- (sin ang)) 0.0) (list (sin ang) (cos ang) 0.0) '(0.0 0.0 1.0) ) ) ) (mapcar '+ (mxv mat (mapcar '+ (vxs pt scl) (vxs (cdr (assoc 10 elst)) (- scl)) (cdr (assoc 12 elst)) ) ) (cdr (assoc 17 elst)) ) ) ;; VXS Multiply a vector by a scalar ;; ;; Arguments : a vector and a real (defun vxs (v s) (mapcar (function (lambda (x) (* x s))) v)) ;; VXV (gile) ;; Returns the dot product of two vectors (real) ;; ;; Arguments : two vectors ;; return : a real number (defun vxv (v1 v2) (apply '+ (mapcar '* v1 v2))) ;; TRP ;; transposes a matrix -Doug Wilson- ;; ;; Argument : a matrix ;; return : a matrix (defun trp (m) (apply 'mapcar (cons 'list m))) ;; MXV ;; Applies a transformation matrix to a vector -Vladimir Nesterovsky- ;; ;; Arguments : une matrice et un vecteur ;; return : a vector (defun mxv (m v) (mapcar '(lambda (r) (vxv r v)) m) ) ;; MXM ;; Multiplies (combinates) two matrices -Vladimir Nesterovsky- ;; ;; Arguments : deux matrices ;; return : a matrix (defun mxm (m q) (mapcar '(lambda (r) (mxv (trp q) r)) m) )

 

Distinguished Contributor
msarqui
Posts: 136
Registered: ‎09-14-2010
Message 5 of 9 (654 Views)

Re: Outline projection all viewports to model

12-09-2011 09:39 AM in reply to: alanjt_

Hi alanjt_

 

This routine is pretty amazing.

It is exactly what I was looking for.

Thank you very very much!

 

Marcelo

 

 

Valued Mentor
alanjt_
Posts: 483
Registered: ‎08-25-2008
Message 6 of 9 (648 Views)

Re: Outline projection all viewports to model

12-09-2011 10:27 AM in reply to: msarqui

Glad you like it. :smileyhappy:

 

When it prompts to select viewports, if you type "AL" or "ALL", it will drawn the border for all viewports in the drawing.

*Expert Elite*
pbejse
Posts: 2,502
Registered: ‎11-24-2009
Message 7 of 9 (632 Views)

Re: Outline projection all viewports to model

12-10-2011 01:08 AM in reply to: alanjt_

Nice coding Alanjt

 

Cheers

 

 

Valued Mentor
alanjt_
Posts: 483
Registered: ‎08-25-2008
Message 8 of 9 (623 Views)

Re: Outline projection all viewports to model

12-10-2011 08:15 AM in reply to: msarqui

Thanks, but gile transformation code was the bulk of the acutal work. :smileyhappy:

New Member
aosrom
Posts: 1
Registered: ‎10-16-2012
Message 9 of 9 (539 Views)

Re: Outline projection all viewports to model

10-16-2012 05:50 AM in reply to: alanjt_

Hello,

 

The  vp-outline.lsp is very good.

 

There exist some updates to work with circular viewports?

 

Best regards

Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Announcements
Are You Going To Be @ AU 2014? Feel free to drop by our AU topic post and share your plans, plug a class that you're teaching, or simply check out who else from the community might be in attendance. Ohh and don't forgot to stop by the Autodesk Help | Learn | Collaborate booths in the Exhibit Hall and meet our community team if you get a chance!