Hi,
Here is my version of Copying a Block from another Drawing, inspired by Tony's code, but with a bit more error trapping etc.
Let me know how you get on:
;;----------------------=={ Copy Block }==--------------------;;
;; ;;
;; Copies the specified block definition from the specified ;;
;; filename to the ActiveDocument using a deep clone ;;
;; operation (Method inspired by Tony Tanzillo) ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; block - string specifying block name to copy ;;
;; filename - filename of drawing from which to copy block ;;
;;------------------------------------------------------------;;
;; Returns: Block definition in ActiveDocument, else nil ;;
;;------------------------------------------------------------;;
(defun LM:CopyBlock ( block filename / acapp acdoc acblk acdocs dbxDoc item )
(vl-load-com)
;; © Lee Mac 2010
(setq acapp (vlax-get-acad-object)
acdoc (vla-get-ActiveDocument acapp)
acblk (vla-get-Blocks acdoc))
(vlax-map-collection (vla-get-Documents acapp)
(function
(lambda ( doc )
(setq acdocs
(cons
(cons (strcase (vla-get-fullname doc)) doc) acdocs
)
)
)
)
)
(if
(and
(not (LM:Itemp acblk block))
(setq filename (findfile filename))
(not (eq filename (vla-get-fullname acdoc)))
(or
(setq dbxDoc (cdr (assoc (strcase filename) acdocs)))
(progn
(setq dbxDoc (LM:ObjectDBXDocument))
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-open (list dbxDoc filename))
)
)
)
)
(setq item (LM:Itemp (vla-get-Blocks dbxDoc) block))
)
(vla-CopyObjects dbxDoc
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbObject '(0 . 0)) (list item)
)
)
acblk
)
)
(and dbxDoc (vlax-release-object dbxDoc))
(LM:Itemp acblk block)
)
;;-----------------=={ ObjectDBX Document }==-----------------;;
;; ;;
;; Retrieves a version specific ObjectDBX Document object ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: - None - ;;
;;------------------------------------------------------------;;
;; Returns: VLA ObjectDBX Document object, else nil ;;
;;------------------------------------------------------------;;
(defun LM:ObjectDBXDocument ( / acVer )
;; © Lee Mac 2010
(vla-GetInterfaceObject (vlax-get-acad-object)
(if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
"ObjectDBX.AxDbDocument"
(strcat "ObjectDBX.AxDbDocument." (itoa acVer))
)
)
)
;;-----------------------=={ Itemp }==------------------------;;
;; ;;
;; Retrieves the item with index 'item' if present in the ;;
;; specified collection, else nil ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; coll - the VLA Collection Object ;;
;; item - the index of the item to be retrieved ;;
;;------------------------------------------------------------;;
;; Returns: the VLA Object at the specified index, else nil ;;
;;------------------------------------------------------------;;
(defun LM:Itemp ( coll item )
;; © Lee Mac 2010
(if
(not
(vl-catch-all-error-p
(setq item
(vl-catch-all-apply
(function vla-item) (list coll item)
)
)
)
)
item
)
)
;; Test Function
(defun c:test ( / *error* doc blk dwg pt norm )
(vl-load-com)
;; © Lee Mac 2010
(defun *error* ( msg )
(and dbxDoc (vlax-release-object dbxDoc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(if (and
(setq blk (getstring t "\nSpecify Name of Block to Copy: "))
(setq dwg (getfiled "Select Drawing to Copy From" "" "dwg" 16))
(LM:CopyBlock blk dwg)
(setq pt (getpoint "\nPick Point for Block: "))
)
(progn
(setq norm (trans '(0. 0. 1.) 1 0 t))
(vla-insertBlock
(if
(or
(eq AcModelSpace
(vla-get-ActiveSpace
(setq doc
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
)
)
(eq :vlax-true (vla-get-MSpace doc))
)
(vla-get-ModelSpace doc)
(vla-get-PaperSpace doc)
)
(vlax-3D-point (trans pt 1 0)) blk 1. 1. 1.
(angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 norm t))
)
)
)
(princ)
)
[ test function included ]
Lee
