[编程交流] 将对象复制到新dwg

(defun c:test (/ acdoc ss filename array n dbxdoc try)
 (vl-load-com)
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (if (and
       (setq ss (ssget))
       (setq filename (getfiled "Target file" "" "dwg" 0))
     )
   (progn
     (setq n     (sslength ss)
           array (vlax-make-safearray vlax-vbObject (cons 0 (1- n)))
     )
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet acdoc))
       (vlax-safearray-put-element array (setq n (1- n)) obj)
     )
     (vla-delete ss)
     (setq dbxdoc
            (vlax-create-object
              (if (< (setq release (atoi (getvar "ACADVER"))) 16)
                "ObjectDBX.AxDbDocument"
                (strcat "ObjectDBX.AxDbDocument." (itoa release))
              )
            )
     )
     (if
       (vl-catch-all-error-p
         (setq try (vl-catch-all-apply 'vla-open (list dbxdoc filename)))
       )
        (princ (strcat "\nError: " (vl-catch-all-error-message try)))
        (progn
          (vla-CopyObjects acdoc array (vla-get-ModelSpace dbxdoc))
          (vla-SaveAs dbxdoc filename)
        )
     )
     (vlax-release-object dbxdoc)
   )
 )
 (princ)
)

6