copy objects to a new dwg

[haustab]

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

[gile]

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)

[devitg]

Hi Gile I got this error

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

 

 

I add the (VL-LOAD-COM)

[haustab]

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?

[Lee Mac]

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)

[gile]

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.

[haustab]

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.

[Lee Mac]

Hi Haustab,

 

Thanks for your compliments, much appreciated.

 

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

[Lee Mac]

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

[haustab]

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!

[gile]

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

[gile]

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

[Lee Mac]

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

 

Good to know, thanks Gile.

[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.

[haustab]

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...

[Lee Mac]

Thanks Gile