Visual LISP, AutoLISP and General Customization

[#1]

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!

[#2]

Hi .

May I ask what do you mean by project viewport ?

[#3]

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".

[#4 · Accepted solution]

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)
)

[#5]

Hi alanjt_

This routine is pretty amazing.

It is exactly what I was looking for.

Thank you very very much!

Marcelo

[#6]

Glad you like it.

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

[#7]

Nice coding Alanjt

Cheers

[#8]

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

[#9]

Hello,

The  vp-outline.lsp is very good.

There exist some updates to work with circular viewports?

Best regards