VLA-COPYOBJECTS

VLA-COPYOBJECTS

john.uhden
Mentor Mentor
2,520 Views
7 Replies
Message 1 of 8

VLA-COPYOBJECTS

john.uhden
Mentor
Mentor

This was my first semi-successful attempt at using this function.

I adapted it right out of the help.

The purpose is to copy missing layers (of choice) from one drawing to another.  Both must be open in the same AutoCAD session.

All works fine except at the very end and I don't know why.

(defun c:copylayers ( / docs source target layers spec objCollection count)
  (defun @msgbox (Title Buttons Message / useri1 value)
    (vl-load-com)
    (or *acad* (setq *acad* (vlax-get-acad-object)))
    (setq useri1 (getvar "useri1"))
    (acad-push-dbmod)
    (vla-eval
      *acad*
      (strcat
        "ThisDrawing.SetVariable \"USERI1\","
        "MsgBox (\""
        Message "\","
        (itoa Buttons) ",\""
        Title "\")"
      )
    )
    (setq value (getvar "useri1"))
    (setvar "useri1" useri1)
    (acad-pop-dbmod)
    value
  )
  (and
    (setq *acad* (vlax-get-acad-object)
          docs (vlax-get *acad* 'Documents)
          target (vlax-get *acad* 'ActiveDocument)
    )
    (or
      (> (vlax-get docs 'count) 1)
      (prompt "There are no other drawings open.")
    )
    (or
      (= (vlax-get docs 'count) 2)
      (prompt "There are more than just one (1) other drawing open.")
    )
    (vlax-for doc docs
      (if (not (equal doc target))(setq source doc))
      1
    )
    source
    (setq ans (@msgbox "PAY ATTENTION" 52 "The current drawing is the target.\nThe other drawing is the source.\n\nDo you wish to continue?"))
    (= ans 6) ;; Yes
    (setq spec (getstring "\nEnter layer spec: "))
    (vlax-for layer (vlax-get source 'layers)
      (if (wcmatch (strcase (vlax-get layer 'Name))(strcase spec))
        (setq layers (cons layer layers))
      )
      1
    )
    layers
    (setq objCollection (vlax-make-safearray vlax-vbObject (cons 0 (- (length layers) 1)))
	  count 0
    )
    ;; Build collection as an array
    (foreach layer layers
      (vlax-safearray-put-element objCollection count layer)
      (setq count (1+ count))
    )
    ;; Copy objects and get back a collection of the new objects (copies)
    (setq Copies (vla-CopyObjects source objCollection (vlax-get target 'layers)))
    (print Copies)
    ;; **** THIS IS WHERE IT FAILS ****
    (setq Copylist (vlax-safearray->list (vlax-variant-value Copies)))
  )
  (princ)
)

John F. Uhden

0 Likes
Accepted solutions (1)
2,521 Views
7 Replies
Replies (7)
Message 2 of 8

Lee_Mac
Advisor
Advisor
Accepted solution

The error arises because the upper bound of the first dimension of the safearray will be -1, indicating that the safearray is empty. The reason for the absence of objects in the safearray returned by this method is revealed by the documentation for the copyobjects method:

Return Value (RetVal)

Type: Variant (array of objects)

An array of newly created duplicate objects. Only primary objects are returned in this array. For more information on what occurred during the CopyObjects operation, or a list of objects owned by primary objects that were also copied, consult the IDPairs parameter.

0 Likes
Message 3 of 8

john.uhden
Mentor
Mentor
WOW. There's a lesson for ya!
Many thanks!

John F. Uhden

0 Likes
Message 4 of 8

ronjonp
Mentor
Mentor

Alternatively if you don't want to mess with arrays, use vlax-invoke like so:

 

(defun c:foo (/ ad s)
  ;; RJP » 2021-03-31
  ;; Example to copy selected objects to all tabs
  (cond	((setq s (ssget ":L"))
	 (setq s (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))))
	 (setq ad (vla-get-activedocument (vlax-get-acad-object)))
	 (vlax-for l (vla-get-layouts ad)
	   (or (= (getvar 'ctab) (vla-get-name l))
	       (vlax-invoke ad 'copyobjects s (vla-get-block l) nil)
	   )
	 )
	)
  )
  (princ)
)(vl-load-com)

 

0 Likes
Message 5 of 8

john.uhden
Mentor
Mentor
@ronjonp
I almost always prefer using vlax-invoke. I'll have to study your offering.
Right now I am immersed in getting a fatal bug out of a FindFiles program.
The dialog gets frozen, and I need it for the project I'm working on.

John F. Uhden

0 Likes
Message 6 of 8

Sea-Haven
Mentor
Mentor

Did you look at Lee's steal.lsp it can be program driven so can pass dwg name and objects to STEAL. It may be quicker solution.

0 Likes
Message 7 of 8

john.uhden
Mentor
Mentor
Haven't yet.
But today I built a FindFiles program that searches through our CAD
projects folder for drawings by wildcard name, puts them in a list showing
the project # and lets you open one so you can "steal" what you find.

John F. Uhden

0 Likes
Message 8 of 8

Sea-Haven
Mentor
Mentor

Its very simple, from Lee's program.

 

 

;;  The following example will attempt to import Layers: 'Layer1' & 'Layer2',    ;;
;;  and all Dimension Styles beginning with 'DimStyle' (not case-sensitive)      ;;
;;  from the drawing: 'C:\My Folder\MyDrawing.dwg' into the current drawing.     ;;
;;                                                                               ;;
;;  (Steal "C:\\My Folder\\MyDrawing.dwg"                                        ;;
;;     '(                                                                        ;;
;;          ("Layers" "Layer1" "Layer2")                                         ;;
;;          ("Dimension Styles" "DimStyle*")                                     ;;
;;      )                                                                        ;;
;;  )   

 

0 Likes