help with a routine lisp routine that will make life easier for me :)

[Anonymous]

Hey guys and gals,

I need help from one of you Lisp experts that will allow me to.... 

quickly select from two separate blocks and copy a certain attribute value (from each block) then insert a block with those two values within the inserted block.

One of the attributes needed from one block is named ASSET_NUM and the other required from another block is the same ASSET_NUM

the block inserted is named SLLANTERN_NUM_NEW with the attributes which contains two attributes SNUMBER and CNUMBER.

thats basically it.. its driving me crazy as i have looked everywhere for an easier way and this LISP routine code is the hardest thing in the world to understand...

much appriciated 🙂

Rico

[john.uhden]

Let me see if I've got this at all.  You want to combine attribute values from two (2) separate block insertions into one (1) block with two (2) attributes, right?  How do you hope to select the source blocks, by picking them by eye, as in pick, pick, boom?  I presume that the order in which you pick them makes a difference since both attributes have the same tag.  I also presume that the target block is already defined in the drawing, but gets inserted with each pair of picks, and that you will pick the insertion point of the new block.  Or are your dreams more exotic, or automatic?

Whatever, we hope that the intent of this exercise is to help you learn enough to help yourself.

[Anonymous]

hi john

Yes basically just a pick, pick, boom solution.. And yes select them by eye.

insertion point is basically wherever.

I have an amount of 100's of these to do so adding them manually is a bit painful at times.. Just the use of this will simplify my job quite a lot. If not i'll just keep doing it the way i am now.. 

[scot-65]

Umm... How versed are you with LISP?

I might be able to provide partial snippets of code as a beginning.

 (if (and (setq a (entsel "Select an ATTRIBUTE: "))
          (setq a2 (entsel "\nSelect the other ATTRIBUTE: ")) );and
  (if (= (cdr (assoc 0 (entget (car a)))) "INSERT")
   (progn
    (setq b (nentselp (cadr a)))
    (if (= (cdr (assoc 0 (entget (car b)))) "ATTRIB")
     (progn
      (setq bn (cdr (assoc 2 (entget (car a))))) ;block name
      (setq bt (cdr (assoc 2 (entget (car b))))) ;tag name
      (setq bv (cdr (assoc 1 (entget (car b))))) ;tag value
 

I believe the above was written in such a way as the user must actually select the attribute itself.

The code will have to be adjusted if a selection set (ssget) or the user select the block

object itself (and not it's attribute).

To iterate thru a block and check to see if there is a matching attribute name, here is

a partial snippet of code:

       (setq b (entget (ssname s n)))
       (setq f "1")
       (while f
        (setq b (entget (entnext (cdr (assoc -1 b)))))
        (if (= (cdr (assoc 0 b)) "SEQEND")
         (setq f nil)
         (if (= (cdr (assoc 2 b)) bt)
          (progn
           ;;this is where you will save the attribute value
          );progn
         );if
        );if
       );while

The insert part of your code should be easy...

untested (incomplete snippets)

???

[devitg]

A sample and true DWG , will help us to help you . Sad to say , ACAD , can not handle image.

[john.uhden]

Hi, Enrico.

I am working on it for you, but a little confused.  If both of the picked blocks contain attributes named ASSET_NUM, then how do you tell which of them goes to SNUMBER vs. CNUMBER?  Is it by the order of your picks, meaning the first ASSET_NUM goes to SNUMBER and the second goes to CNUMBER?

And in the new block does SNUMBER come before CNUMBER?

Also, is the SLLANTERN_NUM_NEW block already defined in the drawing or at least exists in your search path?

[john.uhden]

Enrico,

A few more things...

1.  Please post a DWG of the SLLANTERN_NUM_NEW block saved back to 2000 format.

2.  Do you want them inserted on/at

     a.  A specific layer?

     b.  A constant rotation angle?

     c.  A constant scale?

3.  Do you want the selected blocks deleted?  If yes, then before or after the insertion?

[john.uhden]

@Anonymous,

Here's my attempted solution.  It's really not tested, so let me know how it doesn't work.

Our thanks to @pbejse for the ATTREQ suggestion.

(defun c:TransAtts ( / *error* cmdecho attreq @getatts delete e obj1 obj2 atts att1 att2 warn)
  ;; By John Uhden (08-08-17) dedicated to Enrico
  ;; Adapted from MTJOIN.lsp by John Uhden
  ;; The objective is to take attributes from two separate block insertions
  ;; and place them as attributes into a new block insertion.
  ;; Thanks go to @pbejse (PBGV) for his ATTREQ suggestion.
  (gc)
  (vl-load-com)
  (or *acad* (setq *acad* (vlax-get-acad-object))) ;; global
  (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*))) ;; global
  (defun *error* (error)
    (setvar "cmdecho" cmdecho)
    (setvar "attreq" attreq)
    (vla-endundomark *doc*)
    (if obj1 (vla-highlight obj1 0))
    (if obj2 (vla-highlight obj2 0))
    (cond
      ((not error))
      ((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
      (1 (princ (strcat "\nERROR: " error)))
    )
    (princ)
  )
  (vla-endundomark *doc*)
  (vla-startundomark *doc*)
  (setq cmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq attreq (getvar "attreq"))
  (setvar "attreq" 0)
  (command "_.expert" (getvar "expert")) ;; dummy command
 
  (defun @getatts (obj  / atts Items)
     (and
        (or
          (= (vlax-get obj 'ObjectName) "AcDbBlockReference")
          (prompt "\nSelected entity is not a block insertion.")
        )
        (or
          (equal (vla-get-hasattributes obj) :vlax-true)
          (prompt "\nBlock selected has no attributes.")
        )
        (setq atts (vla-getattributes obj))
        (setq atts (vlax-variant-value atts))
        (foreach att (vlax-safearray->list atts)
           (setq Tag (vlax-get att 'TagString)
                      Str (vlax-get att 'TextString)
                      Items (cons (list Tag Str Att) Items)
           )
        )
     )
     (reverse Items)
  )
 ;;*************************************************************
  (initget "Yes No")
  (if (not (setq delete (getkword "\nDelete selected blocks? |<Yes>/No|: ")))
    (setq delete "Yes")
  )
  (while (setq e (car (entsel "\nSelect 1st block: ")))
    (and
      (not (vla-highlight (setq obj1 (vlax-ename->vla-object e)) 1))
      (setq atts (@getatts obj1))
      (or
        (setq att1 (cadr (assoc "ASSET_NUM" atts)))
        (prompt "\nBlock does not contain \"ASSET_NUM\" attribute.")
      )
      (setq e (car (entsel "\nSelect 2nd block: ")))
      (not (vla-highlight (setq obj2 (vlax-ename->vla-object e)) 1))
      (setq atts (@getatts obj2))
      (or
        (setq att2 (cadr (assoc "ASSET_NUM" atts)))
        (prompt "\nBlock does not contain \"ASSET_NUM\" attribute.")
      )
      (setq bname "SLLANTERN_NUM_NEW")
      (cond
        ((tblsearch "block" bname))
        ((setq bname (findfile (strcat bname ".dwg"))))
        ((prompt (strcat "\nCannot find block \"" bname "\"")))
      )
      (setvar "cmdecho" 1)
      (vl-cmdf "_.insert" bname)
      (while (> (getvar "cmdactive") 0)(command pause) 1)
      (setq atts (@getatts (vlax-ename->vla-object (entlast))))
      (if (setq att (assoc "SNUMBER" atts))
        (not (vlax-put (last att) 'TextString att1))
        (setq warn (princ"\nThere is no \"SNUMBER\" attribute."))
      )
      (if (setq att (assoc "CNUMBER" atts))
        (not (vlax-put (last att) 'TextString att2))
        (setq warn (princ"\nThere is no \"CNUMBER\" attribute."))
      )
      (not warn)
      (= delete "Yes")
      (not (setq obj1 (vla-delete obj1)))
      (not (setq obj2 (vla-delete obj2)))
    )
  )
  (*error* nil)
)
(defun c:TA ()(c:TransAtts))

[Anonymous]

Hello John,

I appreciate the help 🙂

Just to answer your questions.

a) yes i would like them to be just on layer "Equip_SL_SP_NEW"

b) the rotation set to "90 deg"

c) the standard scale of just 1

And the selected blocks are not required to be deleted.

Here's a drawing that includes the blocks that would require the information/attributes and also the block that will be inserted.

Once again thank yo so much for the help.

I have tried the .lisp routine though it come up with a "stringp nil."

[john.uhden]

I'll figure out the stringp error and include the layer setting.

If the layer doesn't exist, what color do you want it to be?

Linetype?

Do you mind if I have it ask you for the insertion point before it begins the "insert" command?

Right now I have it asking if you want to delete the selected blocks, with a default of "Yes."
Do you want me to change the default to "No" or just skip the option altogether and not delete?

As to rotation, do you want me to adjust for viewtwist?

You want me to add the prefix "C " to the SNUMBER attribute?

You want me to add the prefix "L " to the CNUMBER attribute?

The 2nd block has an attribute tag of "ASSET_NUM_001."  Is that the standard, or should I do a wildcard check ... "ASSET_NUM*?"

If yes, is that for both the 1st and 2nd, or for only the 2nd?

After all this, I trust that you will study each line of code and learn to create these thingies yourself.

[Anonymous]

Hi John,

If the layer doesn't exist, what color do you want it to be?

Linetype?

layer "0"

Do you mind if I have it ask you for the insertion point before it begins the "insert" command?

that is fine

Right now I have it asking if you want to delete the selected blocks, with a default of "Yes."
Do you want me to change the default to "No" or just skip the option altogether and not delete?

just leave it as i am trying to work out how this function works within the code.

As to rotation, do you want me to adjust for viewtwist?

yes please

You want me to add the prefix "C " to the SNUMBER attribute?

yes please

You want me to add the prefix "L " to the CNUMBER attribute?

yes please

The 2nd block has an attribute tag of "ASSET_NUM_001."  Is that the standard, or should I do a wildcard check ... "ASSET_NUM*?"

If yes, is that for both the 1st and 2nd, or for only the 2nd?

not too sure what you mean here. i can only see the attribute ASSET_NUM on both blocks.

After all this, I trust that you will study each line of code and learn to create these thingies yourself.

Oh i have been reading this code over and over trying to work out how you have come about it.. will take some time but i'll get there 🙂 Just the amount of set variables are something im going to have to read about again.

thank you

[john.uhden]

Quoting...

"The 2nd block has an attribute tag of "ASSET_NUM_001."  Is that the standard, or should I do a wildcard check ... "ASSET_NUM*?"

If yes, is that for both the 1st and 2nd, or for only the 2nd?

not too sure what you mean here. i can only see the attribute ASSET_NUM on both blocks."

I am not mistaken about the 2nd block (with the attribute value of "654321").

Just list it and you will see.  Unless the saving back to 2000 altered things.  Try looking at the saved-back version.

Did anyone else look and notice this?

Fear not, the super-able folks around here will conquer this challenge (he said as if volunteering others who aren't even looking).

[Anonymous]

i have saved it as Acad 2000 format though i dont get the different attribute. ive even tried it on another PC with Acad 2016 and same thing.

i have supplied a screen shot.

[john.uhden]

That's odd.  I looked at your screen capture and it indicated what you say, but the block name is "COLUMN_NEW" whereas the drawing that you sent me has instead an anonymous block named "*U4."  I guess that something got screwed up in translation.  We will stick with what you have, plain "ASSET_NUM."  I will fix the other things when I get a chance, hopefully soon.

[john.uhden · Accepted solution]

Enrico:

After many surprises, blunders, and trials, I think I have it all.

See attached TransAtts.lsp

[Anonymous]

you sir... are a legend!

Gonna spend the next few hours trying to decipher what you have coded.

thank you again.

[john.uhden]

Enrico,

There was a logical error in my last post, one that you may not run into, but I'd rather be 99.999% correct.

 Please use the new file attached below.