Copy all attributes from one block to another---except one

[nelsonbriles]

I work with AutoCad Electrical. I've been using an amazing Lisp file by Alan J. Thompson (who is a frequent contributor) call Match Attributes Values and it has been a enormous time saver.

 

However, with AutoCad Electrical, the electrical blocks called "components" have an attribute called Tag1 that gives the component its uniqueness. It is this (and only this) attribute that I DON'T want to change when I copy all attributes between these blocks.

 

I attached the wonderful MAV code. (I hopes that's okay.)

 

Can someone help me in modifying the code that would change all attributes except one labelled "TAG1". (and maybe one or two others possible additional tags--for future.)

 

Thank you for any help.

mav.lsp

[Lee Mac]

Welcome to the forums nelsonbriles

 

Give this a shot:

;; Match Attribute Values (With Exceptions)  -  Lee Mac

(defun c:mav ( / _ssget except inc lst ss1 ss2 val )

   (defun _ssget ( msg mode filter / sel )
       (setvar 'NOMUTT 1)
       (princ msg)
       (setq sel (vl-catch-all-apply 'ssget (list mode filter)))
       (setvar 'NOMUTT 0)
       (if (and sel (not (vl-catch-all-error-p sel)))
           sel
       )
   )

   (setq except '("TAG1")) ;; Exceptions, must be upper-case

   (if
       (and
           (setq ss1 (_ssget "\nSelect Source Block: " "_+.:E:S" '((0 . "INSERT") (66 . 1))))
           (setq ss2 (_ssget "\nSelect Blocks to Match: " "_:L"  '((0 . "INSERT") (66 . 1))))
       )
       (progn
           (foreach att (vlax-invoke (vlax-ename->vla-object (ssname ss1 0)) 'getattributes)
               (if (not (member (strcase (vla-get-tagstring att)) except))
                   (setq lst (cons (cons (strcase (vla-get-tagstring att)) (vla-get-textstring att)) lst))
               )
           )
           (repeat (setq inc (sslength ss2))
               (foreach att (vlax-invoke (vlax-ename->vla-object (ssname ss2 (setq inc (1- inc)))) 'getattributes)
                   (if (setq val (cdr (assoc (strcase (vla-get-tagstring att)) lst)))
                       (vla-put-textstring att val)
                   )
               )
           )
       )
   )
   (princ)
)
(vl-load-com) (princ)

Change the 'except' list as necessary to suit your requirements.

Edited December 5, 2019 by Lee Mac

[nelsonbriles]

Thank you, Lee Mac. You are now in third place in my list of favorite "Macs"--behind John McEnroe (the tennis player/broadcaster) and Macaroni 'n Cheese BUT AHEAD of McDonald's Big Macs.

 

Your logic is so compact. (How does one keep all the parenthesis in proper arrangement? I see how programmers try to line them up but still.....Do you use a Lisp editor with a special "parenthesis counter upper"?)

 

Anyway, I'm planning on learning some Lisp soon so I apologize for this simple LISP question...

 

When you stated, "Change the 'except' list as necessary to suit your requirements".

 

How would that look? Like this...

 

(setq except '("TAG1", "TAG2", TAG3")) ;; Exceptions, must be upper-case

 

or like this...

 

(setq except '("TAG1"),("TAG2")) ;; Exceptions, must be upper-case

 

or some other another syntax.

 

Thanks again.

 

 

 

 

[Lee Mac]

Sorry for the delay in my response nelsonbriles, I must've somehow missed your reply - by chance I was browsing the recent threads.

 

Thank you, Lee Mac. You are now in third place in my list of favorite "Macs"--behind John McEnroe (the tennis player/broadcaster) and Macaroni 'n Cheese BUT AHEAD of McDonald's Big Macs.

 

That's understandable... Macaroni 'n Cheese is nice...

 

Your logic is so compact.

 

Thanks - just for kicks, it could actually be coded with slightly more concision if I sacrificed the customised selection messages which necessitate the local '_ssget' function; but I think its clearer for the user this way.

 

(How does one keep all the parenthesis in proper arrangement? I see how programmers try to line them up but still.....Do you use a Lisp editor with a special "parenthesis counter upper"?)

 

For LISP, my code editor of choice is the Visual LISP IDE (VLIDE) provided with AutoCAD which does actually provide a code formatting utility - however, I don't like the results that it produces, so tend to format the code manually as I write it - maybe my OCD has something to do with it too...

 

For everything else, there's Notepad++

 

Anyway, I'm planning on learning some Lisp soon so I apologize for this simple LISP question...

 

When you stated, "Change the 'except' list as necessary to suit your requirements".

 

How would that look? Like this...

 

(setq except '("TAG1", "TAG2", TAG3")) ;; Exceptions, must be upper-case

 

or like this...

 

(setq except '("TAG1"),("TAG2")) ;; Exceptions, must be upper-case

 

Not quite that complicated, simply:

 

([color=BLUE]setq[/color] except '([color=MAROON]"TAG1"[/color] [color=darkred]"TAG2" TAG3"[/color]))

 

Glad you like the program, and thanks for your kind compliments.

 

Cheers,

 

Lee

[nelsonbriles]

Thanks again, Lee.

 

Since I've realized some nice time savings I've donated on your site. (James Lang from USA).

 

As you probably know, AutoCad Electrical is a very special beast. Each block (called components in ACADE)--whether schematic or panel---have a ton of attributes, ranging from about 10 - 20.

 

Anyway, since you seem generous with your help, how would your algorithm change to copy just, say, 4 attributes. For instance, say, I have a block with 20 attributes: "Tag1", Tag"2", ...., "Tag 20". Instead of copying all 20 except for a couple (which is what your "MAV" code does now), a reverse "MAV" would be nice to have in one's arsenal, where just a few (specified) Block Attributes have to be copied throughout many blocks in a drawing. I've downloaded your powerful Batte.lsp but, since I guess it's a batch type of algorithm, it won't work on the drawing I'm editing. (Though I will use it for other tasks!)

[Lee Mac]

To repay the kindness of your donation (many thanks!), here is the modified Match Attribute Values code to only match those attributes listed in the 'include' list:

;; Match (specific) Attribute Values  -  Lee Mac

(defun c:mav ( / _ssget include inc lst ss1 ss2 val )

   (defun _ssget ( msg mode filter / sel )
       (setvar 'NOMUTT 1)
       (princ msg)
       (setq sel (vl-catch-all-apply 'ssget (list mode filter)))
       (setvar 'NOMUTT 0)
       (if (and sel (not (vl-catch-all-error-p sel)))
           sel
       )
   )

   (setq include '("TAG1" "TAG2")) ;; Tags to be matched, must be upper-case

   (if
       (and
           (setq ss1 (_ssget "\nSelect Source Block: " "_+.:E:S" '((0 . "INSERT") (66 . 1))))
           (setq ss2 (_ssget "\nSelect Blocks to Match: " "_:L"  '((0 . "INSERT") (66 . 1))))
       )
       (progn
           (foreach att (vlax-invoke (vlax-ename->vla-object (ssname ss1 0)) 'getattributes)
               (if (member (strcase (vla-get-tagstring att)) include)
                   (setq lst (cons (cons (strcase (vla-get-tagstring att)) (vla-get-textstring att)) lst))
               )
           )
           (repeat (setq inc (sslength ss2))
               (foreach att (vlax-invoke (vlax-ename->vla-object (ssname ss2 (setq inc (1- inc)))) 'getattributes)
                   (if (setq val (cdr (assoc (strcase (vla-get-tagstring att)) lst)))
                       (vla-put-textstring att val)
                   )
               )
           )
       )
   )
   (princ)
)
(vl-load-com) (princ)

I hope it helps you and other members of the forum

Edited December 5, 2019 by Lee Mac

[KeithSWD]

I have been looking for a LISP routine to copy attribute values between blocks for ages, and thought my search had come to an end. But unfortunately I need one that will run in Autocad for MAC, which doesn't have Visual LISP (vl-load-com generates an error straight off). I can't use a VBA solution either. If anyone knows a pure LISP solution please let me know, it is beyond my abilities to write one!

thanks

[Lee Mac]

KeithSWD said:

I have been looking for a LISP routine to copy attribute values between blocks for ages, and thought my search had come to an end. But unfortunately I need one that will run in Autocad for MAC, which doesn't have Visual LISP (vl-load-com generates an error straight off). I can't use a VBA solution either. If anyone knows a pure LISP solution please let me know, it is beyond my abilities to write one!

 

The following program will match all attribute values between selected blocks, and should run on AutoCAD for Mac:

;; Match Attribute Values  -  Lee Mac

(defun c:mav ( / idx lst ss1 ss2 )
   (if
       (and
           (princ "\nSelect Source Block: ")
           (setq ss1 (ssget "_+.:E:S" '((0 . "INSERT") (66 . 1))))
           (princ "\nSelect Blocks to Match: ")
           (setq ss2 (ssget "_:L"     '((0 . "INSERT") (66 . 1))))
           (setq lst (LM:getattributes (ssname ss1 0)))
       )
       (repeat (setq idx (sslength ss2))
           (LM:setattributevalues (ssname ss2 (setq idx (1- idx))) lst)
       )
   )
   (princ)
)
       
;; Get Attributes  -  Lee Mac
;; Returns an association list of attributes present in the supplied block.
;; blk - [ent] Block (Insert) Entity Name
;; Returns: [lst] Association list of ((<Tag> . <Value>) ... )

(defun LM:getattributes ( blk / enx )
   (if (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
       (cons
           (cons
               (cdr (assoc 2 enx))
               (cdr (assoc 1 enx))
           )
           (LM:getattributes blk)
       )
   )
)

;; Set Attribute Values  -  Lee Mac
;; Sets attributes with tags found in the assocation list to their associated values.
;; blk - [ent] Block (Insert) Entity Name
;; lst - [lst] Association list of ((<Tag> . <Value>) ... )
;; Returns: nil

(defun LM:setattributevalues ( blk lst / enx itm )
   (if (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
       (if (setq itm (assoc (cdr (assoc 2 enx)) lst))
           (progn
               (if (entmod (subst (cons 1 (cdr itm)) (assoc 1 enx) enx))
                   (entupd blk)
               )
               (LM:setattributevalues blk lst)
           )
           (LM:setattributevalues blk lst)
       )
   )
)
(princ)

The above functions are part of my set of Attribute Functions.

 

Lee

Edited December 5, 2019 by Lee Mac

[KeithSWD]

Well I obviously waited far too long to post here - your solution works a treat! Thank you very much indeed. And I shall investigate your site as I suspect there are lots more goodies there.

 

thanks

 

Keith

[Lee Mac]

You're very welcome Keith

[cwake]

I don't have any experience with AutoCAD for MAC, but I'm interested to see if the following would work where you have fields in the attribute values? Specifically I'm interested where the field refers to another entity's property like a circle's radius or area because I've experimented getting the ObjID without using the ActiveX method... which is new to me.

 

I can thank Lee for pushing me to experiment with this kind of stuff.

 

;; Match Attribute Values  -  Lee Mac
(defun c:mav ( / idx lst ss1 ss2 )
 (if
   (and
     (princ "\nSelect Source Block: ")
     (setq ss1 (ssget "_+.:E:S" '((0 . "INSERT") (66 . 1))))
     (princ "\nSelect Blocks to Match: ")
     (setq ss2 (ssget "_:L"     '((0 . "INSERT") (66 . 1))))
     (setq lst (LM:getattributes (ssname ss1 0)))
     )
   (repeat (setq idx (sslength ss2))
     (LM:setattributevalues (ssname ss2 (setq idx (1- idx))) lst)
     )
   )
 (princ)
 )
;; Get Attributes  -  Lee Mac
;; Returns an association list of attributes present in the supplied block.
;; blk - [ent] Block (Insert) Entity Name
;; Returns: [lst] Association list of ((<Tag> . <Value>) ... )
(defun LM:getattributes ( blk / enx )
 (if (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
   (cons
     (cons
       (cdr (assoc 2 enx))
       (getthefullstring blk)
       )
     (LM:getattributes blk)
     )
   )
 )
;; Set Attribute Values  -  Lee Mac
;; Sets attributes with tags found in the assocation list to their associated values.
;; blk - [ent] Block (Insert) Entity Name
;; lst - [lst] Association list of ((<Tag> . <Value>) ... )
;; Returns: nil
(defun LM:setattributevalues ( blk lst / enx itm )
 (if (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
   (if (setq itm (assoc (cdr (assoc 2 enx)) lst))
     (progn
       (if (entmod (subst (cons 1 (cdr itm)) (assoc 1 enx) enx))
         (entupd blk)
         )
       (LM:setattributevalues blk lst)
       )
     (LM:setattributevalues blk lst)
     )
   )
 )
;; Get the attribute text value and returns the string with the field intact if present.
;; att - [ent] Attribute Entity Name
(defun getthefullstring (att / elist dict fieldref overalldata overallstring nochilds childfields child string noids count1 count2 ids id)
 (if (and (setq dict (cdr (assoc 360 (setq elist (entget att)))))
          (setq fieldref (dictsearch dict "ACAD_FIELD"))
          (setq fieldref (cdr (assoc 360 fieldref)))
          )
   (progn
     (setq overalldata (entget fieldref)
           overallstring (apply 'strcat (mapcar (function (lambda (x) (if (member (car x) '(2 3)) (cdr x) ""))) overalldata))
           nochilds (cdr (assoc 90 overalldata))
           )
     (if (> nochilds 0)
       (progn
         (setq count1 0
               childfields (vl-remove-if-not '(lambda (x) (= (car x) 360)) overalldata)
               )
         (foreach a childfields
           (setq child (entget (cdr a))
                 string (strcat "%<" (cdr (assoc 2 child)) ">%")
                 noids (cdr (assoc 97 child))
                 )
           (if (> noids 0)
             (progn
               (setq count2 0
                     ids (vl-remove-if-not '(lambda (x) (= (car x) 331)) child)
                     )
               (foreach b ids
                 (setq id (rtos (EnameToObjectId (cdr b)) 2 0)
                       string (vl-string-subst (strcat "ObjId " id) (strcat "ObjIdx " (itoa count2)) string)
                       count2 (1+ count2)
                       )
                 );foreach
               );progn
             );if
           (setq overallstring (vl-string-subst string (strcat "%<[url="file://\\_FldIdx"]\\_FldIdx[/url] " (itoa count1) ">%") overallstring)
                 count1 (1+ count1)
                 )
           );foreach
         );progn
       );if
     overallstring
     );progn
   (cdr (assoc 1 elist))
   );if
 )
;; An attempt to get the objID without using vla-get-objectid
;; Converts the ename string from hexadecimal to a decimal number
(defun EnameToObjectId (ename / str)
 (setq str (vl-princ-to-string ename)
       str (substr str 15 (- (strlen str) 15));the ename as a hex string
       )
 (base->decimal 16 str);conversion to decimal
 )
;; Converts val [string] from base X to decimal [real]
(defun base->decimal (base val / pos power result tmp)
 (setq pos (1+ (strlen val))
       power -1
       result 0
       val (strcase val)
       )
 (while (> (setq pos (1- pos)) 0)
   (setq result
          (+
            result
            (* (if (> (setq tmp (ascii (substr val pos 1))) 64)
                 (- tmp 55)
                 (- tmp 48)
                 )
               (expt (float base) (setq power (1+ power)))
               )
            )
         )
   )
 result
 )
(princ)

Edited November 16, 2013 by cwake

[Lee Mac]

I don't have any experience with AutoCAD for MAC, but I'm interested to see if the following would work where you have fields in the attribute values? Specifically I'm interested where the field refers to another entity's property like a circle's radius or area because I've experimented getting the ObjID without using the ActiveX method... which is new to me.

 

I can thank Lee for pushing me to experiment with this kind of stuff.

 

You're welcome cwake - I'm delighted to have inspired you to experiment!

 

Congratulations on your code to extract the attribute content including any field strings present - however, be careful where nested field expressions are concerned, as your function will ignore these

(e.g. "%%[/color] + %%) \\f \"%lu6\">%")

 

To offer some food for thought, consider my Field Code function; though, of course, the Object ID function would need to be converted to Vanilla AutoLISP for operation on AutoCAD for Mac.

 

Where this conversion is concerned, I believe you would need to use a function similar to this demonstrated by VovKa, or this by me in order to correctly convert the hexadecimal entity name to an object ID, since there will be accuracy problems when using doubles to convert a hexadecimal string to a 64-bit integer for 64-bit systems.

 

However, after retrieving the correct field expressions from the attribute value, complete with accurate Object IDs, there would still be a lot of work required to create the Fields in the 'destination' attributes, since, if you wish to entmake a Field, you will also need to entmake the extension dictionary attached to the attribute housing the field expression, in addition to the ACAD_FIELD dictionary within this extension dictionary, the TEXT dictionary within the ACAD_FIELD dictionary, and each of the individual FIELD entities contained within the TEXT dictionary.

 

In essence, you would need to create each of the dictionaries that you traverse when retrieving the field expression from the source attribute value. Whereas, when using Visual LISP, AutoCAD will automatically detect when a field expression is present in the text string, and will automatically generate the required dictionaries.

 

To give an example of creating a Field without the use of Visual LISP, see this example by Tim Willey.

 

Lee

[cwake]

Congratulations on your code to extract the attribute content including any field strings present - however, be careful where nested field expressions are concerned, as your function will ignore these

 

Many thanks Lee.

 

After I posted I found some recursive code on the forums by gile that alerted me to that issue as well, and I was playing with ideas just now. I didn't realise you had done some as well, but I am very keen to have a good look at it now.

 

It would be nice if stuff like this were better documented. If you've ever pulled apart fields inside attributed blocks attached to multileaders please point me to it!! That didn't seem to follow the same rules as standalone blocks when I looked at it.

[gpavlov]

Hi Nelsonbriles,

I've downloaded mav.lsp , LOADED IN to Autocad 2013, but it does not run?

Can you help me on this one?

Georgi

[Todd]

Hello,

 

I have another, very similar, request. I found this thread when I was looking for a way to match an attribute for a block inserted at the same location.

 

What I am doing is placing signal lanterns on poles (traffic signal design). Each lantern (with the red green and yellow lights on it) is associated with a vehicle or pedestrian group and they are mounted on a pole which has a unique identifier (station number).

 

There can be more than one lantern per pole of course - which complicates the task - otherwise I would just include the pole with the lantern block.

 

I would really like the lantern block to automatically pick up the station number of the pole onto which it is inserted. I have been extracting data into a spreadsheet and then grouping by X,Y coordinate (by dynamic block attributes) but I would like to be able to automate, or semi automate, this by having the pole associated with the lanterns affixed to it so the particular attribute for both blocks matched.

 

I would also like to be able to associate each signal group with the inputs that "call" the group, i.e. the induction loops in the road, pedestrian push-buttons and microwave sensors. This is basically what your routines above do and I am pretty confident I can adapt those but I would like to be able to eliminate the extra click if I am inserting into an identical location on plan.

 

This would be useful in other areas of my work too, like being able to associate light fittings in a building with the supplying switch and circuit breaker for example (yes, I know Revit can do this, but I am an AutoCAD person).

 

Hoping the same gurus are out there; it has been a while since this thread was originally started.

 

Thanks

[rjames]

Is it possible to copy the attribute value of block1 (tag1) to block2 (tag2) as a field and then copy the attribute of block2 (tag3) to block1 (tag4)?

[Lee Mac]

Is it possible to copy the attribute value of block1 (tag1) to block2 (tag2) as a field and then copy the attribute of block2 (tag3) to block1 (tag4)?

 

You could try my Copy Field program.

[rjames]

I actually have several attributes that I want copied from the first block that I select to the second block I select, but the source and destination tag names may need to be slightly different (the second block will need a prefix on the tag names). Then I also need to have one of the attributes from the second block copied to the first block. I may be able to get away from the tag prefixes if I do something with nested blocks.

 

 

basically, I could have a point table schedule (i.e. second block) that has attributes for every point available on a controller. I would like to select the devices (i.e. first blocks) that I have already entered the attribute information and then select the point table row to copy the information from the device to the table and also copy the point address from the table back to the device. Hope that makes sense.