Topic: Updating a block routine, ...

[Hangman]

Hey guys,
Can someone please help me with a routine.
This is what I have, but I'm stuck between a rock and hard spot at the moment, I don't have the time to add a little some'thn some'thn to it.

Code: [Select]

(defun c:TY (/ oldecho oldos Sel EntData Txt)
  (defun $error (msg /)
    (if (or (= msg "Function cancelled")
            (/= msg "quit / exit abort")
        )
        (princ (strcat "Error: " msg))
    )
    (command ".undo" "e" "undo" "")
    (command ".redraw")
    (setvar "cmdecho" oldecho)
    (setq *error* old_err)
    (princ)
  );end error
  (setq old_err *error*
        *error* $error
        oldecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (and
    (setq Sel (nentsel "\n Select text to copy: "))
    (setq EntData (entget (car Sel)))
    (setq Txt (cdr (assoc 1 EntData)))
    (setq Sel (nentsel "\n Select attribute to replace: "))
    (setq EntData (entget (car Sel)))
    (entmod (subst (cons 1 Txt) (assoc 1 EntData) EntData))
    (entupd (car Sel)))
  (princ)
)

Could one of you guru's please create a piece of code for me ??

I have a block with an attribute text.  This routine currently gets the info from the attribute text and adds it to another piece of attribute text.
What I need to add is something that will also get the text properties of that attribute text to add to the other.

EXAMPLE:  I have a block (A) with a line of text  "SEE ARCH" with a width of 0.5.
The block I am updating (block 'B') has a line of text "----" with a width of 0.75.

I need to be able to select the text of block 'A' and select the text of block 'B' and have the text of block 'B' be identical to that of block 'A'.

Thank you in Advance for your expertise.

[Maverick®]

  Hiya Hangman.  How's about changing the thread name to something a little more descriptive?

  "Copying block text" or something like that.

[Guest]

  Hiya Hangman.  How's about changing the thread name to something a little more descriptive?

  "Copying block text" or something like that.

If Se7en saw this he'd be rolling over in his grav....What?   He's what?  You mean he's not.... Oh.   Oops!

[JohnK]

Nice subject title Hangman!

(Your quick Mav!)

[Hangman]

Hiya Hangman.  How's about changing the thread name to something a little more descriptive?

Good point, ... I'm in a rush, ...  always in a rush.  

Sorry, ...  Sorry, ...  won't happen again.

[T.Willey]

What properties to do you want to match?  Color? Layer? Lineweight? Width? Height?

Here is a real simple way to do it, and you can add more properties as you like.

Code: [Select]

(and
 (setq Sel (nentsel "\n Select text/attribute to match properties from: "))
 (setq FromObj (vlax-ename->vla-object (car Sel)))
 (setq Sel (nentsel "\n Select text/attribute to match properties to: "))
 (setq ToObj (vlax-ename->vla-object (car Sel)))
 (mapcar
  '(lambda (x)
   (vlax-put ToObj x (vlax-get FromObj x))
  )
  '("Height" "Color" "Layer" "ScaleFactor")
 )
)


[Hangman]

What properties to do you want to match?  Color? Layer? Lineweight? Width? Height?

Good question, sorry I didn't post this earlier.  I'm just looking for width at the moment.
I am assuming, at some later date when I have a few seconds, I can take and expand on it.

[deegeecees]

Width = DXF code 41

[deegeecees]

Haven't tested but it should work:

Code: [Select]

(defun c:TY (/ oldecho oldos Sel EntData Txt)
  (defun $error (msg /)
    (if (or (= msg "Function cancelled")
            (/= msg "quit / exit abort")
        )
        (princ (strcat "Error: " msg))
    )
    (command ".undo" "e" "undo" "")
    (command ".redraw")
    (setvar "cmdecho" oldecho)
    (setq *error* old_err)
    (princ)
  );end error
  (setq old_err *error*
        *error* $error
        oldecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (and
    (setq Sel (nentsel "\n Select text to copy: "))
    (setq EntData (entget (car Sel)))
    (setq Txt (cdr (assoc 1 EntData)))
    (setq wid (cdr (assoc 41 EntData)))
    (setq Sel (nentsel "\n Select attribute to replace: "))
    (setq EntData (entget (car Sel)))
    (entmod (subst (cons 1 Txt) (assoc 1 EntData) EntData))
    (entmod (subst (cons 41 wid) (assoc 41 EntData) EntData))
    (entupd (car Sel)))
  (princ)
)
Added:
    (setq wid (cdr (assoc 41 EntData)))
    (entmod (subst (cons 41 wid) (assoc 41 EntData) EntData))

[T.Willey]

What properties to do you want to match?  Color? Layer? Lineweight? Width? Height?

Good question, sorry I didn't post this earlier.  I'm just looking for width at the moment.
I am assuming, at some later date when I have a few seconds, I can take and expand on it.

In my code, width = SacleFactor.  So you can erase the others and just leave that one in.

[Hangman]

( ...  taking a breath, ...  reading ...  reading ...  breathing, ...  OK, times up !! )

Thanks guys, I appreciate the help.
Tried the code posted from both Tim & DGC, but alas, ...
It seems to incorporate the width factor, but it won't do the text now.
It's as if the one (the Wid) is over-riding the other (Txt).

[T.Willey]

( ...  taking a breath, ...  reading ...  reading ...  breathing, ...  OK, times up !! )

Thanks guys, I appreciate the help.
Tried the code posted from both Tim & DGC, but alas, ...
It seems to incorporate the width factor, but it won't do the text now.
It's as if the one (the Wid) is over-riding the other (Txt).

To copy the text also, have the list of properties look like

Code: [Select]

'("ScaleFactor" "TextString")

[Hangman]

To copy the text also, have the list of properties look like

Code: [Select]

'("ScaleFactor" "TextString")

No, it does put the program back to copying the text, but it doesn't do both the text and the width.

Hmmm, ...  it's a good thing I came to you guys, I wouldn't of figured this out.  I've tried a couple different things, ended up with two different programs.
I appreciate your help.

[T.Willey]

To copy the text also, have the list of properties look like

Code: [Select]

'("ScaleFactor" "TextString")

No, it does put the program back to copying the text, but it doesn't do both the text and the width.

Hmmm, ...  it's a good thing I came to you guys, I wouldn't of figured this out.  I've tried a couple different things, ended up with two different programs.
I appreciate your help.

This works with my testing here.

Code: [Select]

(and
 (setq Sel (nentsel "\n Select text/attribute to match properties from: "))
 (setq FromObj (vlax-ename->vla-object (car Sel)))
 (setq Sel (nentsel "\n Select text/attribute to match properties to: "))
 (setq ToObj (vlax-ename->vla-object (car Sel)))
 (mapcar
  '(lambda (x)
   (vlax-put ToObj x (vlax-get FromObj x))
  )
  '("ScaleFactor" "TextString")
 )
)


[terrycadd]

It sounds like you're needing something like the following.

Code: [Select]

;-------------------------------------------------------------------------------
; c:TAM - Text and Attribute Match
;-------------------------------------------------------------------------------
(defun c:TAM (/ EntList@ EntName^ EntPick@ EntType$ Loop Match$ Next$ Text$)
  (princ "\nText and Attribute Match")
  (if (setq EntPick@ (nentsel "\nSelect text or attribute text to match: "))
    (progn
      (setq EntName^ (car EntPick@)
            EntList@ (entget EntName^)
            Match$ (if (assoc 1 EntList@) (cdr (assoc 1 EntList@)))
            Loop (if Match$ t nil)
            Next$ ""
      );setq
      (while Loop
        (if (setq EntPick@ (nentsel (strcat "\nSelect " Next$ "text or attribute text to replace with \"" Match$ "\": ")))
          (setq EntName^ (car EntPick@)
                EntList@ (entget EntName^)
                Text$ (if (assoc 1 EntList@) (cdr (assoc 1 EntList@)))
          );setq
        );if
        (if Text$
          (progn
            (setq EntList@ (entmod (subst (cons 1 Match$) (assoc 1 EntList@) EntList@))
                  EntType$ (cdr (assoc 0 EntList@))
            );setq
            (entupd EntName^)
            (if (or (= EntType$ "MTEXT")(= EntType$ "TEXT"))
              (command "REGEN")
            );if
          );progn
          (progn
            (princ "\nNo text or attribute text selected to replace.")
            (setq Loop nil)
          );progn
        );if
        (setq Next$ (if (= Next$ "") "next " ""))
      );while
    );progn
    (princ "\nNo text or attribute text selected to match.")
  );if
  (princ)
);defun c:TAM
This loop version doesn't modify the width, only the text.

[deegeecees]

Code: [Select]

(defun c:TY (/ oldecho oldos Sel EntData Txt)
  (defun $error (msg /)
    (if (or (= msg "Function cancelled")
            (/= msg "quit / exit abort")
        )
        (princ (strcat "Error: " msg))
    )
    (command ".undo" "e" "undo" "")
    (command ".redraw")
    (setvar "cmdecho" oldecho)
    (setq *error* old_err)
    (princ)
  );end error
  (setq old_err *error*
        *error* $error
        oldecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (and
    (setq Sel (nentsel "\n Select text to copy: "))
    (setq EntData (entget (car Sel)))
    (setq Txt (cdr (assoc 1 EntData)))
    (setq wid (cdr (assoc 41 EntData)))
    (setq Sel (nentsel "\n Select attribute to replace: "))
    (setq EntData (entget (car Sel)))
    (entmod (subst (cons 1 Txt) (assoc 1 EntData) EntData))
    (entupd (car Sel))
    (setq EntData (entget (car Sel)))
    (entmod (subst (cons 41 wid) (assoc 41 EntData) EntData))
    (entupd (car Sel)))
  (princ)
)
Fixed, width and text content works.