VLA-Copyobjects

[ccowgill]

Since AUGI screwed up their their site, and I've lost all access to previous posts, I thought I would try joining here.

I had previously posted a question in regards to using VLA-Copyobjects. What I have is a routine that makes a new layer with a suffix provided by the user, then it takes any selected objects, grabs their layer name, adds the suffix, then puts selected objects on the new layer, then freezes them. I'm not sure where the code came from, so I dont know that I should post it. What I'm trying to do is get the program to create a copy of the object and place it on the new layer, instead of the original. I found the VLA-Copyobjects function, but cant seem to get it to work. Does anyone have any good examples, or possibly even something that already accomplishes this?

 

Thanks in advance.

[Lee Mac]

Welcome to CADTutor ccowgill

vla-CopyObjects is better suited to copying between databases, rather than objects within the same database - for this I would use vla-copy.

 

I'll post an example in a bit

[ccowgill]

Thanks for the welcome.

 

That makes sense, If I can remember my other thread, I think that was suggested as well. Peter Jamtgaard did post an example using vla-CopyObjects, but as I said, I lost all access to it. I'll look forward to you example.

[Lee Mac]

I suppose another more elegant way would be to copy all the Objects using CopyObjects to an ObjectDBX document, add the layer suffix to all the layers, then CopyObjects them back into the working document...

[ccowgill]

way over my head. Even though I've been coding for a few years, I'm just now starting to get more heavily into Vlisp. And the new help system for AutoCAD doesnt help that transition.

[Lee Mac]

And the new help system for AutoCAD doesnt help that transition.

 

So true - I tried the AutoCAD 2011 Help for bit and couldn't get on with it at all...

[ccowgill]

I find my self opening up the chm help from the fix they posted and trying to go from there. Another problem is, context enabled help for vla functions has never worked, it always has returned a page not found error. You would think Autodesk would have fixed this by now. Maybe next year...

[Lee Mac]

Had a stab at the CopyObjects method:

 

(defun c:CopytoLayerSuffix ( / *error* doc spc l s dbx var )
 (vl-load-com)
 ;; © Lee Mac 2010

 (defun *error* ( msg )
   (if dbx (vlax-release-object dbx))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (LM:ActiveSpace 'doc 'spc)

 (if (setq l (LM:ss->vla (ssget "_:L" (list (cons 410 (getvar 'CTAB))))))
   (progn
     (setq s (getstring t "\nSpecify Layer Suffix: "))
     
     (setq dbx (LM:ObjectDBXDocument)
           var (vla-CopyObjects doc (LM:ObjectVariant l) (vla-get-ModelSpace dbx))
     )
     (vlax-for l (vla-get-Layers dbx)
       (vl-catch-all-apply '(lambda ( la ) (vla-put-name la (strcat (vla-get-name la) s))) (list l))
     )
     (setq var (vla-CopyObjects dbx var spc))
     (vlax-release-object dbx)
     (
       (lambda ( ss )
         (mapcar '(lambda ( o ) (ssadd (vlax-vla-object->ename o) ss))
           (vlax-safearray->list
             (vlax-variant-value var)
           )
         )
         (sssetfirst nil ss)
       )
       (ssadd)
     )      
   )
 )
 (princ)
)

;;-------------------=={ Object Variant }==-------------------;;
;;                                                            ;;
;;  Creates a populated Object Variant                        ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  lst - list of VLA Objects to populate the Variant.        ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Object Variant                              ;;
;;------------------------------------------------------------;;

(defun LM:ObjectVariant ( lst )
 ;; © Lee Mac 2010
 (LM:SafearrayVariant vlax-vbobject lst)
)

;;------------------=={ Safearray Variant }==-----------------;;
;;                                                            ;;
;;  Creates a populated Safearray Variant of a specified      ;;
;;  data type                                                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  datatype - variant type enum (eg vlax-vbDouble)           ;;
;;  data     - list of static type data                       ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Variant Object of type specified            ;;
;;------------------------------------------------------------;;

(defun LM:SafearrayVariant ( datatype data )
 ;; © Lee Mac 2010
 (vlax-make-variant
   (vlax-safearray-fill
     (vlax-make-safearray datatype (cons 0 (1- (length data))))
     data
   )    
 )
)

;;-----------------=={ ObjectDBX Document }==-----------------;;
;;                                                            ;;
;;  Retrieves a version specific ObjectDBX Document object    ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments: - None -                                       ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA ObjectDBX Document object, else nil         ;;
;;------------------------------------------------------------;;

(defun LM:ObjectDBXDocument ( / acVer )
 ;; © Lee Mac 2010
 (vla-GetInterfaceObject (vlax-get-acad-object)
   (if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
     "ObjectDBX.AxDbDocument"
     (strcat "ObjectDBX.AxDbDocument." (itoa acVer))
   )
 )
)

;;-----------------=={ SelectionSet -> VLA }==----------------;;
;;                                                            ;;
;;  Converts a SelectionSet to a list of VLA Objects          ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  ss - Valid SelectionSet (Pickset)                         ;;
;;------------------------------------------------------------;;
;;  Returns:  List of VLA Objects                             ;;
;;------------------------------------------------------------;;

(defun LM:ss->vla ( ss )
 ;; © Lee Mac 2010
 (if ss
   (
     (lambda ( i / e l )
       (while (setq e (ssname ss (setq i (1+ i))))
         (setq l (cons (vlax-ename->vla-object e) l))
       )
       l
     )
     -1
   )
 )
)

;;--------------------=={ ActiveSpace }==---------------------;;
;;                                                            ;;
;;  Retrieves pointers to the Active Document and Space       ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  *doc - quoted symbol (other than *doc)                    ;;
;;  *spc - quoted symbol (other than *spc)                    ;;
;;------------------------------------------------------------;;

(defun LM:ActiveSpace ( *doc *spc )
 ;; © Lee Mac 2010
 (set *spc
   (vlax-get-property
     (set *doc
       (vla-get-ActiveDocument
         (vlax-get-acad-object)
       )
     )
     (if (= 1 (getvar 'CVPORT)) 'PaperSpace 'ModelSpace)
   )
 )
)

Edited December 2, 2010 by Lee Mac

[Lee Mac]

I find my self opening up the chm help from the fix they posted and trying to go from there. Another problem is, context enabled help for vla functions has never worked, it always has returned a page not found error. You would think Autodesk would have fixed this by now. Maybe next year...

 

Exactly - that functionality worked *sometimes* in 2010 - but it referenced the VBA articles, but in 2011 with no VBA documentation whatsoever, the effective VL help is gone.

[Lee Mac]

Updated the above to display the resultant SelSet.

[ccowgill]

It's going to take a little bit for me to process your code and fully understand it, then perhaps I can actually contribute something and solve the issue with failing if the layer already exists. I've never used the vlax-for to do layer stuff, I've always used a foreach (which by the looks of it, pretty much does the same type of thing.)

[Lee Mac]

I've never used the vlax-for to do layer stuff, I've always used a foreach (which by the looks of it, pretty much does the same type of thing.)

 

Not quite - the vlax-for is used to iterate a VLA Collection, foreach a list - but syntactically similar, yes.

 

I was undecided as to the route to take should the possibility of a duplicate layer arise - should the user be continuously prompted to specify a different suffix, or should the operation just omit those items which could not be copied...

[ccowgill]

Well, what the existing program does, is it asks for one suffix, then whatever layer the object is on, no matter the layer name gets moved to the new layer, for example, if you have 3 objects, one on "Text", one on "Dim", one on "Circle". you run the program, it asks for the suffix, you specify " New". Three new layers are created "Text New", "Dim New", and "Circle New". then the object that was on "Text" is put on the layer "Text New", etc..

 

So in theory if you could introduce something similar to this:

(setq listlayer (vla-get-layers acaddocument))
     (foreach y lst
       (if (wcmatch (car y) "*`**")
         ()
         (if (tblsearch "LAYER" (car y))
           ()
           (vla-add listlayer (car y))
         ) ;_ end of if
       ) ;_ end of if
     ) ;_ end of foreach

you wouldnt get the error if the layer already existed. (I took this code from another program dealing with layers and layerstates, so its current form would need to be adjusted to work with this program, but the principle should be the same) Create the layers as a separate function, then copy the object assuming the layer already exists.

[ccowgill]

Well the good news is, after testing it, I dont get any errors if the layers already exist, just have to figure out a way to use spaces.

[Lee Mac]

Actually, using the CopyObjects method shouldn't create an issue with duplicate layers - I take back that bug

[Lee Mac]

Well the good news is, after testing it, I dont get any errors if the layers already exist, just have to figure out a way to use spaces.

 

That would be the snvalid test, allows spaces except at the start of the string... perhaps use a difference string validation test.

 

Edited code to remove string validation.

[ccowgill]

That would be the snvalid test, allows spaces except at the start of the string... perhaps use a difference string validation test.

 

well, in the past a simple

(setq s (getstring "\nSpecify Layer Suffix: "))

has worked, and I just know that I have to include the string within quotes if I want to use a space. Otherwise the program works great. Thanks for the help, and the quick lesson in some of these new functions I've never used before.

[Lee Mac]

well, in the past a simple

(setq s (getstring "\nSpecify Layer Suffix: "))

has worked, and I just know that I have to include the string within quotes if I want to use a space. Otherwise the program works great. Thanks for the help, and the quick lesson in some of these new functions I've never used before.

 

As edited, you would use:

 

(setq s (getstring t "\nSpecify Layer Suffix: "))

But, this will fail if the user enters a "*" or "/" as these aren't valid symbols for table names - the code itself won't crash, rather just won't assign the new layers.

[ccowgill]

it does not seem to work with a space at the beginning of the suffix, and if you try to use " it doesnt assign the new layer. However, if I get rid of the t after getstring, it will allow me to add a space between the layer name and the suffix by using quotes. Or I could always modify the strcat to include a space by default.

[Lee Mac]

it does not seem to work with a space at the beginning of the suffix, and if you try to use " it doesnt assign the new layer. However, if I get rid of the t after getstring, it will allow me to add a space between the layer name and the suffix by using quotes. Or I could always modify the strcat to include a space by default.

 

All works fine for me using the code as it stands.

 

The quote characters won't be valid table names.

 

The [cr] argument for the getstring is required to allow for spaces.