[编程交流] 从其他图纸插入块

;;----------------------=={ 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:instbl ( / *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)
)

^C^C(LM:CopyBlock "BlockName" "C:\\MyDrawing.dwg")