;;-------------------------=={ Copy to XRef }==-------------------------;;
;;                                                                      ;;
;;  This program enables the user to copy a selection of objects to a   ;;
;;  selected xref, without opening the xref source drawing.             ;;
;;                                                                      ;;
;;  Upon calling the program with 'c2x' at the command-line, the user   ;;
;;  is prompted to make a selection of objects to copy. Following a     ;;
;;  valid response, the user is then prompted to select an External     ;;
;;  Reference (xref) to which the objects are to be copied.             ;;
;;                                                                      ;;
;;  The program will then proceed to copy the selected objects to the   ;;
;;  source drawing of the selected xref using a deep-clone method,      ;;
;;  coupled with an ObjectDBX interface should the xref source drawing  ;;
;;  be unopened in the current drawing session.                         ;;
;;                                                                      ;;
;;  Upon copying the selection, the xref source drawing is saved and    ;;
;;  the xref is reloaded in the current drawing; the selected objects   ;;
;;  are then deleted from the current drawing.                          ;;
;;                                                                      ;;
;;  The program will account for the position, scale, rotation &        ;;
;;  orientation of the xref relative to the selection of objects and    ;;
;;  will perform successfully under all UCS & View settings.            ;;
;;                                                                      ;;
;;  Please Note:                                                        ;;
;;  ------------------------------                                      ;;
;;  The act of copying objects to the xref source drawing involves      ;;
;;  saving the external drawing remotely - this action cannot be        ;;
;;  undone within the current drawing and changes to the external       ;;
;;  drawing must be reset manually.                                     ;;
;;                                                                      ;;
;;  Note that when saving drawings through ObjectDBX, drawing file      ;;
;;  thumbnails will be lost until the next manual save.                 ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2014  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.2    -    2014-06-21                                      ;;
;;----------------------------------------------------------------------;;
;¸´ÖÆÊµÌåµ½Íâ²¿²ÎÕÕÎÄ¼þ[lm_c2xref]
(defun c:lm_c2xref ( / *error* acd app dbx def doc dwg dwl ent enx err inc lst mat obj sel vrs xrl )

    (defun *error* ( msg )
        (if (and (= 'vla-object (type dbx)) (not (vlax-object-released-p dbx)))
            (vlax-release-object dbx)
        )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (while (setq def (tblnext "block" (null def)))
        (if (= 4 (logand 4 (mai_dxf 70 def)))
            (setq xrl (vl-list* "," (mai_dxf 2 def) xrl))
        )
    )
    (cond
        (   (= 1 (getvar 'xloadctl))
            (princ "\nXLOADCTLÏµÍ³±äÁ¿±»Éè¶¨Îª 1, Íâ²¿²ÎÕÕÎÄ¼þ±»Ëø¶¨.")
        )
        (   (not
                (and
                    (setq sel (mai_select_first
                                    (list '(0 . "~VIEWPORT")
                                          '(-4 . "<NOT")
                                               '(-4 . "<AND") '(0 . "INSERT") (cons 2 (apply 'strcat (cdr xrl))) '(-4 . "AND>")
                                          '(-4 . "NOT>")
                                           (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model"))
                                    )
                                    "Ñ¡ÔñÒª¸´ÖÆµ½Íâ²¿²ÎÕÕÎÄ¼þÊµÌå :"
                                    "Ã»ÓÐÕÒµ½ÊµÌå."
                              )           
                    )
                    (progn
                        (while
                            (progn
                                (setvar 'errno 0)
                                (setq ent (car (entsel "\nÑ¡ÔñÍâ²¿²ÎÕÕ :")))
                                (cond
                                    (   (= 7 (getvar 'errno))
                                        (princ "\n¿ÕÑ¡£¬ÔÙÊÔÒ»´Î.")
                                    )
                                    (   (= 'ename (type ent))
                                        (setq enx (entget ent))
                                        (if (or (/= "INSERT" (mai_dxf 0 enx))
                                                (not (member (mai_dxf 2 enx) xrl))
                                            )
                                            (princ "\nÑ¡ÔñµÄÊµÌå²»ÊÇÍâ²¿²ÎÕÕ.")
                                        )
                                    )
                                )
                            )
                        )
                        ent
                    )
                )
            )
        )
        (   (progn
               (setq app (vlax-get-acad-object)
                     vrs (atoi (getvar 'acadver))
                     vrs (if (< vrs 16) "" (strcat "." (itoa vrs)))
                     vrs (strcat "objectdbx.axdbdocument" vrs)
                     dbx (vl-catch-all-apply 'vla-getinterfaceobject (list app vrs))
               )
               (or (null dbx) (vl-catch-all-error-p dbx))
            )
            (prompt "\nÎÞ·¨·ÃÎÊ ObjectDBX.")
        )
        (   (not
                (and
                    (setq dwg (mai_dxf 1 (tblsearch "block" (mai_dxf 2 enx))))
                    (setq dwg (findfile dwg))
                )
            )
            (prompt "\nÎÞ·¨¶¨Î»Íâ²¿²ÎÕÕÎÄ¼þ.")
        )
        (   (progn
                (vlax-for doc (vla-get-documents app)
                    (setq dwl (cons (cons (strcase (vla-get-fullname doc)) doc) dwl))
                )
                (not
                    (or (setq doc (mai_dxf (strcase dwg) dwl))
                        (and (not (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vla-open (list dbx dwg)))))
                             (setq doc dbx)
                        )
                    )
                )
            )
            (prompt (strcat "\nÎÞ·¨¶¨Î»Íâ²¿²ÎÕÕÎÄ¼þ:\n" (vl-catch-all-error-message err)))
        )
        (   (setq mat (mai_blk_RevMatrix ent)
                  mat (vlax-tmatrix (append (mapcar 'append (car mat) (mapcar 'list (cadr mat))) '((0. 0. 0. 1.))))
                  acd (vla-get-activedocument app)
            )
            (setq lst (mapcar 'vlax-ename->vla-object (mai_ssget_2_list sel)))
            (foreach obj lst (vla-transformby obj mat))
            (vlax-invoke acd 'copyobjects lst (vla-get-modelspace doc))
            (vla-saveas doc dwg)
            (vla-reload (vla-item (vla-get-blocks acd) (mai_dxf 2 enx)))
            (foreach obj lst (vla-delete obj)) ;; Comment this line to retain original objects
        )
    )
    (and (= 'vla-object (type dbx))
         (not (vlax-object-released-p dbx))
         (vlax-release-object dbx)
    )
    (princ)
)
