move attribute values between blocks

I can probably do this in VBA quite quickly but the drawing is needed out today so I may have to do it by hand - unless somebody kind can knock out a quick & dirty LISP for me.

Basically I have pairs of blocks, some with the correct information and some that require changing. I need to read the correct information, create a new string based on that then populate the other block with the new string, over-writing what is already there.

So....

Select first block (named "Reference")

read "Ref" attribute value (the only attribute)

Select second block (named "CableNumber")

populate "Cable" attribute with "LAN A"

These have to be selected individually, not as a selection set.

Many thanks if somebody is willing to give it a shot.

If I understood you well this would get the text sting from the first selected Attribute block and inserted into the second selected one .

BUT: you should select the string itself directly ( hit the string ).

(defun c:Test (/ ss1 ss2 e1 e2)(vl-load-com)
 (if
   (and
     (setq ss1 (nentsel "\n Select the first Attribute Block:"))
     (eq (cdr (assoc 0 (setq e1 (entget (car ss1))))) "ATTRIB")
     (setq ss2 (nentsel "\n Select the first Attribute Block:"))
     (eq (cdr (assoc 0 (setq e2 (entget (car ss2))))) "ATTRIB")
   )
    (vla-put-Textstring
      (vlax-ename->vla-object (car ss2))
      (vla-get-Textstring (vlax-ename->vla-object (car ss1)))
    )
 )
 (princ)
)

Good luck.

Thanks Tharwat. I will have a look at that in a little while but in the meantime I will use the following VBA one I just put together.

I wasn't sure that I would get it working so I didn't come back here to report. I have NO error trapping so it is far from ideal.

I hope I haven't wasted too much of your time.

Option Explicit

Public Sub PickSourceItem()
Dim myAttributes As Variant
Dim myObject As AcadObject
Dim P1 As Variant
Dim myName As String
Dim myText As AcadText
Dim layerColl As AcadLayers
Dim CloudLayer As AcadLayer
On Error Resume Next
ThisDrawing.Utility.GetEntity myObject, P1, "Select Block"
If Err <> 0 Then
   Err.Clear
   MsgBox "No Object Selected"
   Exit Sub
End If
If myObject.EntityName = "AcDbBlockReference" Then
   myAttributes = myObject.GetAttributes
   myName = myAttributes(0).TextString & " LAN A"
   
ThisDrawing.Utility.GetEntity myObject, P1, "Select Block"
If myObject.EntityName = "AcDbBlockReference" Then
   myAttributes = myObject.GetAttributes
   myAttributes(0).TextString = myName
   End If
   
Else
   MsgBox "Block not selected"
End If
End Sub

You're welcome dbroada .

I hope it would help you with your work , and I hope that I going to know how to deal with VBA routines one day .

regards.

OK, neither is perfect . Yours doesn't create the second string with the additonal text. Mine writes the modified string back to the first block if I miss the 2nd block during selection.

I have a bigger problem in the drawing though. The cable numbers have changed from a 3 digit number to about 16 characters and I don't have enough space but at least I can now prove that quickly.

No problem .

Just tell me what is the target text string in the second selected attributed block going to be .

I guessing this might be as needed .

(defun c:Test (/ ss1 ss2 e1 e2)
 (if
   (and
     (setq ss1 (nentsel "\n Select the first Attribute Block:"))
     (eq (cdr (assoc 0 (setq e1 (entget (car ss1))))) "ATTRIB")
     (setq ss2 (nentsel "\n Select the first Attribute Block:"))
     (eq (cdr (assoc 0 (setq e2 (entget (car ss2))))) "ATTRIB")
   )
    (vla-put-Textstring
      (vlax-ename->vla-object (car ss2))
      (strcat "Cable" " "(vla-get-Textstring (vlax-ename->vla-object (car ss1))) " " "LAN A")
    )
 )
 (princ)
)

nearly,

       (strcat (vla-get-Textstring (vlax-ename->vla-object (car ss1))) " LAN A")

will do.

BUT,

are you able to modify it so that I pick a piece of DTEXT instead of the block for the first part and put that into an attribute in the second block (only one block to be selected).

I have just realised I have a mixture of blocks & text on this drawing.

Many many thanks if you do.

Certainly I would do it for you .

First Select the Text then select the Att. text string in the Att. Block to be replaced .

Undo option is added to the routine .

(defun c:Test (/ acdoc ss1 ss2 e1 e2)(vl-load-com)
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))

 (vla-StartUndoMark acdoc)
 
 (if
   (and
     (setq ss1 (nentsel "\n Select Text to get its string:"))
     (eq (cdr (assoc 0 (setq e1 (entget (car ss1))))) "TEXT")
     (setq ss2 (nentsel "\n Select the first Attribute Block:"))
     (eq (cdr (assoc 0 (setq e2 (entget (car ss2))))) "ATTRIB")
   )
    (vla-put-Textstring
      (vlax-ename->vla-object (car ss2))
      (strcat
        (vla-get-Textstring (vlax-ename->vla-object (car ss1)))
      )
    )
 )
 
 (vla-EndUndoMark acdoc)
 
 (princ)
)

Brilliant - thank you very much. Using a combination of both routines gives me a chance of getting the drawings out today.

You're welcome dbroada .

I am so happy that the routine met your needs .

Best of luck.

Tharwat

Hi Dave,

Bit late to the party, but would this help at all?

(defun c:test ( / ss tx )
 (and
   (setq ss (ssget "_+.:E:S" '((0 . "INSERT") (2 . "Reference") (66 . 1))))
   (setq tx (LM:GetAttributeValue (vlax-ename->vla-object (ssname ss 0)) "REF"))
   (setq ss (ssget "_+.:E:S" '((0 . "INSERT") (2 . "CableNumber") (66 . 1))))
   (LM:SetAttributeValue (vlax-ename->vla-object (ssname ss 0)) "CABLE" (strcat tx " LAN A"))
 )
 (princ)
)

Uses first two subs from here.

Quite possibly but the fat lady (ok, the dinner lady) is beginning to sing.

When this drawing leaves my desk I will look at the solutions - and might even use it as a test for my next VB.Net routine.

Quite possibly but the fat lady (ok, the dinner lady) is beginning to sing.

I thought so :wink:

Not to worry Dave

Maybe like this:

http://www.cadtutor.net/forum/showthread.php?55175-Match-Attribute-Data&highlight=attcopy

-David

That reminds me, I forgot I had this program too..

so I should have spent more time searching