I though it might be fun to see what I can come up with for a better Tab -> Drawings routine. I had to use one a couple of months ago, and would have liked it to be smarter, so I thought to create one which would look at all viewports per layout, and only copy those model space objects that are visible through the viewports per layout. Base is working expect two parts:
1) One of the layouts does not seem to be self generating a main viewport. I do not see a real pattern, as I thought it was the last tab, so I created a new one through the right-click menu, and it would still not create the viewport. I reordered the tab, and the same issue happened. I tried creating a new layout by the command line, and it was still there. Here is an output for the command (does not matter if called from current drawing or ObjectDBX):
Command: T2D
Layout: created, before: 0, after: 3, copied: 3
Layout: copy2, before: 0, after: 5, copied: 4
Layout: test2, before: 0, after: 5, copied: 4
Layout: yes, before: 0, after: 4, copied: 3
Layout: yes (2), before: 0, after: 4, copied: 3
Command:
you can see that all have 1 more object in the layout space than the copied amount except the 'created' drawing. Everything time I run the command, it is always the 'created' layout which does not get the correct amount of objects. Before it was the 'test2' layout. Between testing, I created the 'yes (2)' layout, but the 'test2' layout would still be the layout with the wrong amount of objects.
2) I have not been able to find a way to 'trans' the viewport coordinate for the viewport center (of model space) to WCS. I want this to work with ODBX, so I cannot change into model space and use (trans pt 2 0). I will continue to look for this answer.
The test drawing is attached. Right now the default save path is "c:/test/", but that can be changed. Also with the ODBX version of the command, it looks for the attached drawing in the same directory.
edit: updated code, add Gile's routine per Lee's link.
edit: updated code to correct issue 1 in this post
(defun c:TabsToDwgs ()
(tabsToDwgs (vla-get-ActiveDocument (vlax-get-Acad-Object)) "c:/test/" nil)
(princ)
)
;======================================================
(defun c:t2d ( / *error* dbxdoc oVer dir)
(defun *error* (msg)
(if (and dbxdoc (not (vlax-object-released-p dbxdoc)))
(vlax-release-object dbxdoc)
)
(if msg (vl-bt))
)
;------------------------------------------------------
(setq dbxdoc
(if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
(vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
(vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))
)
)
(setq dir "c:/test/")
(vla-Open dbxdoc (strcat dir "tabs2dwgs.dwg") :vlax-true)
(tabsToDwgs dbxdoc "c:/test/" t)
(*error* nil)
(princ)
)
;======================================================
(defun tabsToDwgs ( doc dir needrelease / *error* getItems doesIntersect
getBoundingPoints isWithinCross getViewPoints findLike
doesPropertyMatch
doc name lst vplist fvp lolist msobjs xdata pt sc wd ht
pts tlist olist dbxdoc oVer dir vp acname polist )
;-------------------------------------------------------
(defun *error* (msg)
(if dbxdoc (vlax-release-object dbxdoc))
(if (and doc needrelease) (vlax-release-object doc))
(if msg (vl-bt))
)
;------------------------------------------------------
(defun getItems (lst code pos / cnt rtn )
(setq cnt 0)
(foreach i lst
(if (equal (car i) code)
(progn
(setq cnt (1+ cnt))
(if (member cnt pos)
(setq rtn (cons (cdr i) rtn))
)
)
)
)
(reverse rtn)
)
;-------------------------------------------------------
(defun doesIntersect ( pt pt2 pts on )
(or
(inters pt pt2 (car pts) (cadr pts) on)
(inters pt pt2 (cadr pts) (caddr pts) on)
(inters pt pt2 (caddr pts) (cadddr pts) on)
(inters pt pt2 (car pts) (cadddr pts) on)
)
)
;-------------------------------------------------------
(defun getBoundingPoints ( obj / ll ur err )
(cond
((= (vla-get-ObjectName obj) "AcDbXline")
(list
(vlax-get obj 'BasePoint)
(vlax-get obj 'SecondPoint)
)
)
(t
(setq err
(vl-catch-all-apply
(function vla-GetBoundingBox)
(list obj 'll 'ur)
)
)
(if
(not
(and
(vl-catch-all-error-p err)
(= (vl-catch-all-error-message err)
"Automation Error. Null extents")
)
)
(progn
(setq ll (safearray-value ll))
(setq ur (safearray-value ur))
(list
ll
(list (car ll) (cadr ur) (caddr ll))
ur
(list (car ur) (cadr ll) (caddr ll))
)
)
)
)
)
)
;-------------------------------------------------------
(defun isWithinCross ( objpts bndpts / ll ur err )
(if (equal (length objpts) 2)
(doesIntersect (car objpts) (cadr objpts) bndpts nil)
(progn
(or
(and
(<= (caar bndpts) (caar objpts) (caaddr bndpts))
(<= (cadar bndpts) (cadar objpts) (cadadr bndpts))
(<= (caar bndpts) (caaddr objpts) (caaddr bndpts))
(<= (cadar bndpts) (cadar (cddr objpts)) (cadadr bndpts))
)
(doesIntersect (car objpts) (cadr objpts) bndpts t)
(doesIntersect (cadr objpts) (caddr objpts) bndpts t)
(doesIntersect (caddr objpts) (cadddr objpts) bndpts t)
(doesIntersect (cadddr objpts) (car objpts) bndpts t)
)
)
)
)
;-------------------------------------------------------
(defun getViewPoints ( vp / xdata pt sc wd ht )
(setq xdata (MyGetXdata vp "ACAD"))
(setq pt (PCS2WCS (vlax-get vp 'Center) vp))
(setq sc (vlax-get vp 'CustomScale))
(setq wd (/ (vlax-get vp 'Width) sc 2))
(setq ht (/ (vlax-get vp 'Height) sc 2))
(list
(list (- (car pt) wd) (- (cadr pt) ht))
(list (- (car pt) wd) (+ (cadr pt) ht))
(list (+ (car pt) wd) (+ (cadr pt) ht))
(list (+ (car pt) wd) (- (cadr pt) ht))
)
)
;-------------------------------------------------------
(defun doesPropertyMatch ( o1 o2 prop )
(equal (vlax-get o1 prop) (vlax-get o2 prop))
)
;-------------------------------------------------------
(defun findLike ( src olist / obj )
(foreach o olist
(if
(and
(doesPropertyMatch src o "ObjectName")
(doesPropertyMatch src o "Center")
(doesPropertyMatch src o "CustomScale")
(doesPropertyMatch src o "Direction")
(doesPropertyMatch src o "Height")
(doesPropertyMatch src o "TwistAngle")
(doesPropertyMatch src o "Width")
)
(setq obj o)
)
)
obj
)
;-------------------------------------------------------
;; 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)
)
;-------------------------------------------------------
(setq acname (vla-get-Name (vla-get-Layout (vla-get-PaperSpace doc))))
(vlax-for lo (vla-get-Layouts doc)
(setq name (vla-get-Name lo))
(setq lst nil)
(setq vplist nil)
(Setq fvp nil)
(vlax-for o (vla-get-Block lo)
(setq lst (cons o lst))
(if (and
(equal (vla-get-ModelType lo) :vlax-false)
(= (vla-get-ObjectName o) "AcDbViewport")
)
(setq vplist (cons (cons o (getViewPoints o)) vplist))
)
(if (and vplist (not fvp))
(progn
(setq fvp t)
(setq vplist nil)
(setq lst (vl-remove o lst))
)
)
)
(setq lolist
(cons
(list
name
(cons "objects" lst)
(cons "viewports" vplist)
)
lolist
)
)
)
(setq msobjs (cdr (assoc "objects" (cdr (assoc "Model" lolist)))))
(foreach o msobjs
(if (setq bpts (getBoundingPoints o))
(foreach l lolist
(setq name (car l))
(foreach vp (cdr (assoc "viewports" (cdr l)))
(if (isWithinCross bpts (cdr vp))
(if (setq tlist (assoc name olist))
(if (not (vl-position o (cdr tlist)))
(setq olist
(subst
(cons name (cons o (cdr tlist)))
tlist
olist
)
)
)
(setq olist (cons (cons name (list o)) olist))
)
)
)
)
)
)
(foreach l lolist
(setq name (car l))
(if (/= name "Model")
(progn
(setq dbxdoc
(if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
(vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
(vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))
)
)
(if (setq tlist (cdr (assoc name olist)))
(vlax-invoke
doc
'CopyObjects
tlist
(vla-get-ModelSpace dbxdoc)
)
)
(if (= name acname)
(setq vp (vlax-invoke (vla-get-PaperSpace dbxdoc) 'AddpViewport '(0. 0. 0.) 1. 1.))
)
(setq polist (cdr (assoc "objects" (cdr l))))
(setq objs
(vlax-invoke
doc
'CopyObjects
polist
(vla-get-Block (vla-item (vla-get-Layouts dbxdoc) "Layout1"))
)
)
(if vp (vla-Delete vp))
(vla-SaveAs dbxdoc (strcat dir name ".dwg"))
(if vp
(progn
(setq vp nil)
(vla-Open dbxdoc (strcat dir name ".dwg"))
(vlax-for o (vla-get-Block (vla-item (vla-get-Layouts dbxdoc) "Layout1"))
(if
(and
(= (vla-get-ObjectName o) "AcDbViewport")
(setq obj (findLike o polist))
)
(vla-put-ViewportOn o (vla-get-ViewportOn obj))
)
)
(vla-SaveAs dbxdoc (strcat dir name ".dwg"))
)
)
(vlax-release-object dbxdoc)
(setq dbxdoc nil)
)
)
)
(*error* nil)
(princ)
)
I think I have included everything.
Thanks in advance.
