copy objects to a new dwg

How to copy objects to a new or better to an other dwg?

 
(defun c:copybypick (/ *acad* doc path tgdbxdoc pck vlobj)
 (setq *acad* (vlax-get-acad-object)
doc    (vla-get-documents *acad*)
 )
 (setq path (getfiled "Select Source File"
        (getvar "dwgprefix")
        "dwg;dwt;dws"
        0
     )
 )
 (setq tgdbxdoc
 (vla-GetInterfaceObject *acad* "ObjectDBX.AxDbDocument.17")
 )
 (vla-open tgdbxdoc path)
 (setq pck   (entsel "Select object: ")
vlobj (vlax-ename->vla-object (car pck))
 )
 ;;;(vla-copyobjects tgdbxdoc vloobj);;;
 (vlax-release-object tgdbxdoc)
 (princ)
)

Hi,

Look at the CopyObjects method in Developer's help > ActiveX and VBA Reference

vla-CopyObjects requieres minimum 3 arguments:

- the source database or document (doc in your case)

- a variant (safearray) whch contains the vla-objects to copy

- the target document (tgdbxdoc)

For the second argument, you have to build a safearray as this :

(setq objvar (vlax-make-variant
              (vlax-safearray-fill
                (vlax-make-safearray
                  vlax-vbObject
                  '(0 . 0)
                )
                (list vlobj)
              )
            )
)
(vla-copyobjects doc objvar tgdbxdoc)

or, simpler using the 'old style' vlax-invoke (which avoid making a saearray):

(vlax-invoke doc 'CopyObjects (list vlobj) tgdbxdoc)

Hi Gile I got this error

; error: ActiveX Server returned the error: unknown name: "COPYOBJECTS"

I add the (VL-LOAD-COM)

Hi gile,

thanks for replay.

If i use your code inside my lines, i get an error!?

I've used (vlax-invoke doc 'CopyObjects (list vlobj) tgdbxdoc)

instead of ;;;(vla-copyobjects ...

Where is the error?

Example:

(defun Copy_Obj (ss blk / ObjLst)
 (vl-load-com)

 (setq ObjLst
   (mapcar 'vlax-ename->vla-object
     (vl-remove-if 'listp
       (mapcar 'cadr (ssnamex ss)))))

 (cond (  (vl-every '= (mapcar 'vla-get-OwnerId ObjLst))

          (vla-copyobjects             
            (vla-get-ActiveDocument
              (vlax-get-acad-object))
            (vlax-make-variant
              (vlax-safearray-fill
                (vlax-make-safearray
                  vlax-vbObject
                    (cons 0 (1- (length ObjLst)))) ObjLst)) blk))))

ss = SelectionSet

blk = Destination Block ~ (Document Variant/ Block Definition)

Sorry, it looks like the (vlax-invoke ...) statement doesn't work with an AxDbDocument (it works with blocks inside the active document.

So use the (vlax-make-variant ...) method.

Hi,

thanks for replay

lee, i get the ss = SelectionSet with (ssget), but is blk = tgdbxdoc (from my lines)?

I'm not sure if i understand it completly...

How to use (Copy_Obj ss blk) whiche type of argument is ss and blk?

@Lee i've seen other projects of you, very good job, top.

Hi Haustab,

Thanks for your compliments, much appreciated.

Yes, blk is the new document, tgdbxdoc in your case. :wink:

Gile could this work?

(defun c:test (/ Copy_obj ss path app docs doc)
 (vl-load-com)

 (defun Copy_Obj (ss blk / ObjLst)
   (vl-load-com)

   (setq ObjLst
     (mapcar 'vlax-ename->vla-object
       (vl-remove-if 'listp
         (mapcar 'cadr (ssnamex ss)))))

   (cond (  (vl-every '= (mapcar 'vla-get-OwnerId ObjLst))

            (vla-copyobjects             
              (vla-get-ActiveDocument
                (vlax-get-acad-object))
              (vlax-make-variant
                (vlax-safearray-fill
                  (vlax-make-safearray
                    vlax-vbObject
                      (cons 0 (1- (length ObjLst)))) ObjLst)) blk))))

 (if (and (setq ss (ssget))
          (setq path (getfiled "File" "" "dwg" 16)))
   (progn

     (setq app (vlax-create-object
                 (strcat "AutoCAD.Application."
                   (itoa (fix (atof (getvar 'ACADVER)))))))

     (vlax-put-property app 'Visible :vlax-true)
       (vlax-put-property
         (vla-get-Display
           (vla-get-preferences app)) 'maxautocadwindow :vlax-true)
 
     (setq docs (vla-get-documents app) doc (vla-open docs path :vlax-false))

     (Copy_obj ss doc)

     (vla-save doc)
     (vla-close doc)

     (vlax-invoke-method app 'quit)

     (mapcar
       (function
         (lambda (x)
           (vlax-release-object x))) (list app docs doc))))

 (princ))

hi Lee,

i don't know...

error

It look's not so easy to copy in an other drawing.

your last code get's an error too. But many to learn for me

Thanks!

Hi,

This seems to work

(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)
)

And with vlax-invoke too:

(defun c:test (/ acdoc ss filename lst 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
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet acdoc))
       (setq lst (cons obj lst))
     )
     (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
          (vlax-invoke acdoc 'CopyObjects lst (vla-get-ModelSpace dbxdoc))
          (vla-SaveAs dbxdoc filename)
        )
     )
     (vlax-release-object dbxdoc)
   )
 )
 (princ)
)

Ah, I didn't know that you had to get the ModelSpace of the new document.

Good to know, thanks Gile.

I replied too quickly the first times and focused on the objects variant argument.

As it's shown in the Developer's help > ActiveX and VBA Reference > Object Model, graphic entities always own to a Block object which can be either a block definition, the ModelSapce or a PaperSpace.

That's the reason why, ModelSpace and PaperSpaces own to the Block Collection.

Respect, it work's.

great... thanks.

"That's the reason why, ModelSpace and PaperSpaces own to the Block Collection." It's a reason, now if you say it.

Thanks...

Thanks Gile