Transfer Attributes from one block to another

[Ranger-uk]

I've been looking for a routine that will allow me to transfer an attribute from one block to another. Ideally I'd like to click on one block which contains the attribute I want (from a field called ID_1), then click on another block and copy the attribute to another specific field (ID_2). I need to do this to quite a few blocks so I'd like to just continue to click between the two types of block.

 

I thought I could modify the code on this page http://www.cadtutor.net/forum/showthread.php?32085-Need-Lisp-to-update-attributes, but this appears to place the same attribute on every block I click. Any help is greatly appreciated!

[Lee Mac]

Perhaps take a look at this general program:

 

http://lee-mac.com/copytext.html

[Lee Mac]

Or a quick one, more specific:

 

(defun c:ca ( / _SelectBlockWithTag a b des src tag ) (vl-load-com)

 (setq src "ID_1"  ; Source Attribute Tag
       des "ID_2"  ; Destination Attribute Tag
 )

 (defun _SelectBlockWithTag ( tag / e a ) (setq tag (strcase tag))
   (while
     (progn (setvar 'ERRNO 0) (setq e (car (entsel (strcat "\nSelect Block with attribute " tag ": "))))
       (cond
         ( (= 7 (getvar 'ERRNO))
           (princ "\nMissed, Try Again.")
         )
         ( (not e)
           nil
         )
         ( (and
             (eq "INSERT" (cdr (assoc 0 (entget e))))
             (= 1 (cdr (assoc 66 (entget e))))
           )
           (if
             (not
               (setq a
                 (vl-some
                   (function
                     (lambda ( x )
                       (if (eq tag (strcase (vla-get-tagstring x))) x)
                     )
                   )
                   (vlax-invoke (vlax-ename->vla-object e) 'getattributes)
                 )
               )
             )
             (princ (strcat "\nBlock does not contain tag " tag "."))
           )
         )
         ( (princ "\nInvalid Object Selected.") )
       )
     )
   )
   a
 )

 (while
   (and
     (setq a (_SelectBlockWithTag src))
     (setq b (_SelectBlockWithTag des))
   )
   (vla-put-textstring b (vla-get-textstring a))
 )
 (princ)
)

[Ranger-uk]

Wow, that was a fast reply. Thanks, that is perfect, exactly what I was after!

[Lee Mac]

You're welcome Ranger-uk

 

Nice to see a fellow countryman around here

[BIGAL]

Just a bit more same subject Lee was going to ask I used VBA to do this problem but use the database position of the attribute in the block not its tag to change its value then it will always work even if the tag is changed. eg attrib(0) is the first attribute record in a block attrib(1) is next and so on.

so a change of value would be

attribs(1).TextString = txtx1

attribs(2).TextString = TXTY1

 

I was trying to find the same but in plain lisp or Vl code due to vba possibly disapearing. Please no suggestions re .NET

[Lee Mac]

Hi BIGAL,

 

If I understand your question correctly, you can use the positions of the attribute objects in the list returned by:

 

(vlax-invoke <Block Object> 'getattributes)

 

Let me know if you need an example, or clarification.

 

Lee

[irneb]

Or you can do it the old-fashioned way (without vla) by using entnext n-times after the block reference ename. That should give you the nth attribute's ename and then use entget on that. E.g.:

(defun getNthAttrib (blk n / en ed)
 (setq en (entnext blk))
 (while (and (> (setq n (1- n)) 0) en) (setq en (entnext en)))
 (if (and (setq ed (entget en)) (eq (cdr (assoc 0 ed)) "ATTRIB")) en)
)

Edited June 7, 2011 by irneb
Modified code for working at last entity

[BIGAL]

Thanks Lee but I am doing something wrong, slowly I am converting to VL the block will have multiple attributes so looking at replacing the attribute value with a string the block can occur multiple times no probs there, get it to work for one for a start.

 

(vlax-invoke (vlax-ename->vla-object e) 'getattributes)) how does this return a list ? In your code your using vla-get-tagstring from the attributes.

 

Any help would be appreciated.

[irneb]

The vlax-invoke generally tries to return a more lisp like value than the vlax-invoke-method or the vla-**** methods. Thus the array returned by the block reference's GetAttributes method is converted to a list through the vlac-invoke. So you end up with a list of ActiveX objects, each pointing to an attribute. So, to get the 4th attribute you'll use the nth function. And to get its TagString:

(vla-get-TagString (nth 3 (vlax-invoke (vlax-ename-vla-object e) 'GetAttributes)))

Though I'd advise to store the list of attribute objects to a variable rather than retrieve them each time you want to work on the list:

(setq attribs (vlax-invoke (vlax-ename-vla-object e) 'GetAttributes))
(vla-get-TagString (nth 3 attribs)) ;Get 4th's TagString
(vla-get-TextString (nth 3 attribs)) ;Get 4th's TextString
(vla-get-TagString (nth 4 attribs)) ;Get 5th's TagString
(vla-get-TextString (nth 4 attribs)) ;Get 5th's TextString

Note though if you use nth with an index of >= the list's length it returns nil - so the vla-get-** functions would cause an error in such cases.

[BIGAL]

Thanks Irneb will have a go tomorrow at get and put the nth x attrib etc this is basicly same method as my VBA code

[alanjt]

This thread may be of interest...

 

http://www.cadtutor.net/forum/showthread.php?48397-Copy-all-attributes...

[irneb]

Thanks Irneb will have a go tomorrow at get and put the nth x attrib etc this is basicly same method as my VBA code

It is very close to the same ideas as in VBA. The major difference is that AutoLisp has no concept of Object Orientation, thus you can't directly call an ActiveX Object's method or work with its properties. For this the vla/vlax functions provide an alternative so it works inside ALisp.

 

Basically there's 3 "official" functions: vlax-invoke-method, vlax-put-property and vlax-get-property. Each of these need the object as its first argument, then the MethodName/PropertyName. Then the vlax-put-property needs the value to store, the vlax-invoke-method "might" need other arguments depending on if the object's method requires them.

 

Then because the ActiveX objects use different data-types than are available inside ALisp, the new variant & safearray types are created. There are several vlax functions to convert, create, modify, etc. on these data types. The undocumented vlax-invoke, vlax-get & vlax-put functions try to automatically convert to-and-from variants & safearrays.

 

Then there are shortcut methods created: the vla-* methods. This is basically done similar to what happens in the vlax-import-type-library function. I.e. a prefix is placed on methods, properties and constants.

 

And due to ActiveX usually using collection type objects, the vlax-for allows you to iterate such collections much like the foreach iterates through normal Lisp-lists.

 

And then when you come to something more advanced is where a method has some ByRef / Out arguments. I.e. where the method modifies an (or more) argument's value. In such case a lisp-"trick" is used. If you pass a variable with a quote prefix it's as if it's passed by reference. Basically it works the other way round than in VBA, where you'd declare your function / sub's arguments as ByRef - you'l quote the variable when calling such function. E.g. when you work with XData the GetXData method sends the types and values in 2 separate arguments as VariantArrays. In such case I'd do something like this:

(vlax-invoke-method Obj 'GetXData "MyXDataAppName" 'XDTypes 'XDValues)
(setq XDTypes (mapcar '(lambda (item) (if (= (type item) 'VARIANT) (vlax-variant-value item) item)) (vlax-safearray->list (vlax-variant-value XDTypes))))
(setq XDValues (mapcar '(lambda (item) (if (= (type item) 'VARIANT)  (vlax-variant-value item) item)) (vlax-safearray->list  (vlax-variant-value XDValues ))))

The last 2 lines is a bit complex for someone coming from VBA, since VBA doesn't have such constructions as mapcar and lambda. But basically what happens here is after converting the variant array into a list of variants, it's run through the "temporary" function made by lambda one at a time. The lambda function here checks if each is a variant, then converts it else just passes it as-is. Then mapcar performs this on each item in the list and passes the modified results as a list. So you end up with the values in lisp-usable types in the 2 lists. It's a lot like what the vlax-invoke function does to try for lisp-like-datatypes, though there it sometimes has problems with these output arguments, so I wouldn't use it in such cases.

[DVDM]

I've been looking for something very similar, and this script from Lee Mac comes the closest to what I want to achieve.

 

Being able to click on the source block, and then the destination block, while specifying different source and destination attributes is exactly what I need. What I can't figure out at this point is how to customise this to copy more than one attribute value with the same operation.

If I could enter a number of different source and destination tags, and copy those values across from the source to the target that would be perfect to quickly update a new title block, with values from an old title block.

 

It would be something like:

Source attribute: "TITLE1" Destination attribute: "NEWTITLE1"

Source attribute: "TITLE2" Destination attribute: "NEWTITLE2"

Source attribute: "TITLE3" Destination attribute: "NEWTITLE3"

Source attribute: "DWGNUM" Destination attribute: "DOCUMENT-NUMBER"

 

The reason I need the ability to select the source and destination block is that I can have multiple blocks of both source and destination within a single dwg file, and they need to have different values (so I can't simply update by block name). Each Layout in the drawing will have only one source, and one destination block.

The source block can have different names ("A4TITLE" "A3TITLE" "A2TITLE" etc.), and you can't tell by looking at the block what block name it has.

The destination block will have the same name each time ("NEWTITLE")

 

I have found some code in this discussion thread that sets out to achieve the updating of multiple attributes in a defineable oldtag > newtag mapping:

http://www.cadtutor.net/forum/showthread.php?73583-Copying-Attribute-data-from-one-tittle-block-to-another

but I don't know how to combine that with this lisp from Lee-Mac that allows to visually pick the source and destination blocks.

 

I also found a lisp that allows to pick a source and destination block and will copy the attribute values across, and that works perfect so long as the attributes have the same name (which in my case they don't):

http://forums.augi.com/showthread.php?94955-Copying-attribute-values-among-blocks

But again there I don't know how to modify that with an oldtag>newtag mapping.

 

Does anyone know how to string these routines together in a way that makes that work? I have attached a drawing with the attributed blocks and attribute names described.

Many thanks!

OldToNewAttributes.dwg

[edris]

Hello. I have a number of closed polylines which are blocks with a name. what I need to do is copying an existing block attribute (ABY) in all of them. then to copy the name of the block into a field named PCOD in the block attribute and then breaking the polyline blocks. I was wondering if there is someone who can help me with it.

[BIGAL]

Post a dwg. 

 

Sounds like replace the block with the original pline and a block/field of say area.

[edris]

I didn't explain my question very good. Each polyline that I have is set like a block with a name and nothing more (a number actually). Then I have the ABY_Piece attribute block that I have to put inside each polyline and copy the name of the polyline in the PCOD field which is not the tag name of the ABY_Piece attribute block. And the next step is to explode the polyline block to make it to a simple closed polyline without any information. I uppload a sample. Thanks.

sample.dwg

[ronjonp]

11 hours ago, edris said:

I didn't explain my question very good. Each polyline that I have is set like a block with a name and nothing more (a number actually). Then I have the ABY_Piece attribute block that I have to put inside each polyline and copy the name of the polyline in the PCOD field which is not the tag name of the ABY_Piece attribute block. And the next step is to explode the polyline block to make it to a simple closed polyline without any information. I uppload a sample. Thanks.

sample.dwg

Give this a try

(defun c:foo (/ _dxf a b p sp)
  ;; RJP » 2019-01-29
  (defun _dxf (c e) (cond ((= 'ename (type e)) (cdr (assoc c (entget e))))))
  (cond
    ((null (setq a (ssget ":L" '((0 . "insert") (66 . 1) (8 . "Dessin_Blocs")))))
     (print "Blocks on layer 'Dessin_Blocs' not found...")
    )
    ((null (tblobjname "block" "ABY_Piece")) (print "'ABY_Piece' block definition not found..."))
    ((setq sp (vlax-ename->vla-object (cdr (assoc 330 (entget (ssname a 0))))))
     (foreach bl (vl-remove-if 'listp (mapcar 'cadr (ssnamex a)))
       (setq p (_dxf 10 bl))
       (setq n (_dxf 2 bl))
       (cond ((setq b (vla-insertblock
			sp
			;; Insertion point offset to locate within boundary
			(vlax-3d-point (+ 30 (car p)) (- (cadr p) 10) 0)
			"ABY_Piece"
			1
			1
			1
			0
		      )
	      )
	      (foreach x (vlax-invoke b 'getattributes)
		(and (wcmatch (vla-get-tagstring x) "PCOD,PNOM") (vla-put-textstring x n))
	      )
	      (foreach d (vlax-invoke (vlax-ename->vla-object bl) 'explode)
		(or (= "AcDbPolyline" (vla-get-objectname d)) (vla-delete d))
	      )
	      (entdel bl)
	     )
       )
     )
    )
  )
  (princ)
)
(vl-load-com)

 

Edited January 29, 2019 by ronjonp

[Polisson]

On 6/6/2011 at 5:51 PM, Lee Mac said:

Or a quick one, more specific:

 

 

(defun c:ca ( / _SelectBlockWithTag a b des src tag ) (vl-load-com)

 (setq src "ID_1"  ; Source Attribute Tag
       des "ID_2"  ; Destination Attribute Tag
 )

 (defun _SelectBlockWithTag ( tag / e a ) (setq tag (strcase tag))
   (while
     (progn (setvar 'ERRNO 0) (setq e (car (entsel (strcat "\nSelect Block with attribute " tag ": "))))
       (cond
         ( (= 7 (getvar 'ERRNO))
           (princ "\nMissed, Try Again.")
         )
         ( (not e)
           nil
         )
         ( (and
             (eq "INSERT" (cdr (assoc 0 (entget e))))
             (= 1 (cdr (assoc 66 (entget e))))
           )
           (if
             (not
               (setq a
                 (vl-some
                   (function
                     (lambda ( x )
                       (if (eq tag (strcase (vla-get-tagstring x))) x)
                     )
                   )
                   (vlax-invoke (vlax-ename->vla-object e) 'getattributes)
                 )
               )
             )
             (princ (strcat "\nBlock does not contain tag " tag "."))
           )
         )
         ( (princ "\nInvalid Object Selected.") )
       )
     )
   )
   a
 )

 (while
   (and
     (setq a (_SelectBlockWithTag src))
     (setq b (_SelectBlockWithTag des))
   )
   (vla-put-textstring b (vla-get-textstring a))
 )
 (princ)
)

 

 

That's sort of thing I'm looking for. The feature I need would be placing field as attribute value to second block. I've seen some solutions, but can't figure it out how to mix them to this invention of Lee. Could you help me guys?

[Lee Mac]

4 hours ago, Polisson said:

That's sort of thing I'm looking for. The feature I need would be placing field as attribute value to second block. I've seen some solutions, but can't figure it out how to mix them to this invention of Lee. Could you help me guys?

 

Assuming I've correctly understood what you are looking to achieve, you could use the example I recently posted here:

https://www.cadtutor.net/forum/topic/55494-insert-a-field-using-lisp/?tab=comments#comment-554477