Lisp for copy text...variations on the theme

[Johnc]

Apologies, I will try to explain.

Historically when a drawing was updated a block called  REVB was inserted this showed the revision letter A, then if the drawing was again updated the same block was inserted and the attributes updated and the revision letter to B and so on.

We are now using Autodesk vault professional and because it will only map to one block instance I have been using the T2 code to copy the attributes values from the most recent REVB to the title block MREVB so that it is mapped to Vault and appears in the vault properties.

Currently I use T2 to copy the details from REVB to MREVB and would like to automate this process and save some time.  Lee’s code I have modified and this works well for all the single line attributes and gets the last inserted block values but not for the multiline attribute.

Thank you very much for your previous reply really good application but over kill for my application.

Regards

John

REVB_TO_MREVB_COPPY_ATT.lsp

MREVB example.dwg

[rlx]

Don't have AutoCAD 2018 here at my work but it seems to me your only problem is the new attribute not being MText. So maybe a tiny tweak to Lee's code would do the trick and first make your attribute of the Mtext type (totally untested)

 

You can do the same with the 'get-part' , check if attribute is of type Mtext and then get its MTextAttributeContent

 

(defun put-att (blk tag val / end enx) ; again, thank you lee mac
  (setq blk (ssname (ssget "x" (list '(0 . "INSERT") (cons 2 blk) (cons 410 (getvar 'ctab)))) 0))
  (while (and (null end) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk))))))))
    (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
      (progn
       ; convert normal attribute to MtextAttribute
        (vl-catch-all-apply 'vlax-put-property (list (vlax-ename->vla-object blk) 'MTextAttribute -1))
        (if (entmod (subst (cons 1 val) (assoc 1 enx) enx))
          (progn (entupd blk) (setq end val))
        )
      )
    )
  )
)

Edited January 17, 2019 by rlx

[Johnc]

Thanks very much for the reply, so I have changed the tags to be the multiline attributes in the drawing ISSUE and MISSUE.  Sorry not experienced with lisp and vbx.

I added the line: “(vl-catch-all-apply 'vlax-put-property (list (vlax-ename->vla-object blk) 'MTextAttribute -1))” does this convert the property to MTEXT?

Sorry if this is a stupid question.

Sample drawing now 2013 format

Thank you again for the help

MREVB example 2013.dwg

REVB_TO_MREVB_COPPY_ATT.lsp

[rlx]

If I understand correctly , you have multiple blocks ("REVB") , these contain the project revision and you want to be able to automatically find the latest project revision letter and put that (letter) in the main revision attribute ("REV") from block "MREVB".

(defun c:t3 ( / ss i lst wai tai)
  (defun tai ( b n / o)
    (setq n (strcase n) o (vlax-ename->vla-object b))
    (if o (vl-some '(lambda (x) (if (= n (strcase (vla-get-tagstring x)))
                                  (vla-get-textstring x)))(vlax-invoke o 'getattributes))))
  (defun wai (b n v / o)
    (setq n (strcase n) o (vlax-ename->vla-object b))
    (if o (vl-some '(lambda (x)(if (= n (strcase (vla-get-tagstring x)))
                                 (progn (vla-put-textstring x v) v))) (vlax-invoke o 'getattributes))))
  (if (setq ss (ssget "x" '((0 . "INSERT") (2 . "REVB"))))
    (progn
      (repeat (setq i (sslength ss)) (setq i (1- i) blk (ssname ss i) lst (cons (tai blk "REV") lst)))
      (if (and lst (setq ss (ssget "x" '((0 . "INSERT") (2 . "MREVB")))))
        (wai (ssname ss 0) "REV" (last (acad_strlsort lst))))
    )
  )
)

check on you later alligator , its shutdown time for my workday that is...

 

 

ok, in case you need to strip any MText formatting, made another version (with a little help from master Lee)

(defun c:t4 ( / ss i lst tai wai LM:UnFormat)
  ;;--------------------------------------------------------=={ UnFormat String }==--------------------------------------------------------;;
  ;;  Returns a string with all MText formatting codes removed - Author: Lee Mac, Copyright © 2011 - www.lee-mac.com                       ;;
  ;;---------------------------------------------------------------------------------------------------------------------------------------;;
  ;;  Arguments: str - String to Process, mtx - MText Flag (T if string is for use in MText) Returns: String with formatting codes removed ;;
  ;;---------------------------------------------------------------------------------------------------------------------------------------;;
  (defun LM:UnFormat ( str mtx / _replace rx sx)
    (defun _replace ( new old str )(vlax-put-property rx 'pattern old)(vlax-invoke rx 'replace str new))
    (setq sx '(("\032" "\\\\\\\\") (" " "\\\\P|\\n|\\t")
               ("$1" "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
               ("$1$2/$3" "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")("$1$2" "\\\\(\\\\S)|[\\\\](})|}")("$1" "[\\\\]({)|{")))
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
      (progn (setq str (vl-catch-all-apply (function (lambda ()(vlax-put-property rx 'global actrue)(vlax-put-property rx 'multiline actrue)
        (vlax-put-property rx 'ignorecase acfalse) (foreach pair sx (setq str (_replace (car pair) (cadr pair) str)))
         (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_replace "\\" "\032" str))))))
          (vlax-release-object rx)(if (null (vl-catch-all-error-p str)) str))))
  ; show attribute value
  (defun tai ( b n / o) (setq n (strcase n) o (vlax-ename->vla-object b))
    (if o (vl-some '(lambda (x) (if (= n (strcase (vla-get-tagstring x)))
                  (vla-get-textstring x)))(vlax-invoke o 'getattributes))))
  ; change attribute value
  (defun wai (b n v / o) (setq n (strcase n) o (vlax-ename->vla-object b))
  (if o (vl-some '(lambda (x)(if (= n (strcase (vla-get-tagstring x)))
                   (progn (vla-put-textstring x v) v))) (vlax-invoke o 'getattributes))))
  ; main routine same as C:T3 but now with stripping out any formatting codes
  (if (setq ss (ssget "x" '((0 . "INSERT") (2 . "REVB"))))
    (progn
      (repeat (setq i (sslength ss)) (setq i (1- i) blk (ssname ss i) lst (cons (tai blk "REV") lst)))
      (if (setq ss (ssget "x" '((0 . "INSERT") (2 . "MREVB"))))
        (wai (ssname ss 0) "REV" (last (acad_strlsort (mapcar '(lambda (x)(LM:UnFormat x nil)) lst)))))
    )
  )
)

 

gr. Rlx

Edited January 17, 2019 by rlx

[Johnc]

Thank you very much for the code and all the help, but I am still not explaining myself clearly.  The Revision letter has no relevance. 

I just want to copy a multiline attribute from the last inserted block to another block. 

Like the original code T2 but hard code the block and attribute,   

Many thanks

John

[rlx]

You're explanation isn't the problem , me getting it clearly is haha. I'm just a little confused. You have a fixed blockname and attribute for your in & output selection.

 

Quote

 

From Blockname = "REVB", attribute, tag = "ISSUE"

To Blockname = "MREVB" attribute, tag = "MISSUE" 
 

 

 

I just see I changed the wrong attribute in my previous function (REV instead of ISSUE) but that's easily changed. My mistake.

 

But if both input and output (block / attribute name) are already fixed , you don't need the T2 code to make a manual selection because selection is also fixed then (there can be only one). And certainly if there is only one REVB and one MREVB block in your drawing. If there can be multiple REVB blocks (like in your sample drawing) to make sure I have the latest version wouldn't I need to find the one with the highest revision letter?

Multiline or not , vla-get-textstring should get the correct string in both cases I believe but else getting the mtext value shouldn't be a problem, neither copying it to an attribute even if that needs its mtext flag enabled as I showed previously. Anywayz its been a long day , it will be a short night , but I will try to update the code tomorrow if my colleagus don't put to much work on my desk.

 

didn't have much time but this seemed to work :

; From Blockname = "REVB", attribute, tag = "ISSUE"
; To Blockname = "MREVB" attribute, tag = "MISSUE"
(defun c:T5 ( / ss i l REVB _rev _issue wai tai)
  ; show attribute content
  (defun tai ( b n / o) (setq n (strcase n) o (vlax-ename->vla-object b))
    (if o (vl-some '(lambda (x) (if (= n (strcase (vla-get-tagstring x)))
      (vla-get-mtextattributecontent x)))(vlax-invoke o 'getattributes))))
  ; change attribute content
  (defun wai (b n v / o) (setq n (strcase n) o (vlax-ename->vla-object b))
    (if o (vl-some '(lambda (x)(if (= n (strcase (vla-get-tagstring x)))
      (progn (vla-put-textstring x v) v))) (vlax-invoke o 'getattributes))))
 
  ; select last occurrence of REVB
  (if (setq ss (ssget "x" '((0 . "INSERT") (2 . "REVB"))))
    (progn
      (repeat (setq i (sslength ss)) (setq b (ssname ss (setq i (1- i))) l (cons (cons (tai b "REV") b) l)))
      (setq REVB (cdr (assoc (last (acad_strlsort (mapcar 'car l))) l)))
    )
  )
  ; show data found (if any) (for testing purposes)
  (if (and REVB (setq _rev (tai REVB "REV")) (setq _issue (tai REVB "ISSUE")))
    (princ (strcat "\nLast revision = " _rev " , issue = " _issue))
    (princ "\nSorry incomplete or missing data")
  )
  ; select MREVB , assuming there is only one
  (if (and _issue (setq b (ssname (ssget "x" (list '(0 . "INSERT") (cons 2 "MREVB") (cons 410 (getvar 'ctab)))) 0)))
    (wai b "MISSUE" _issue))
  (princ)
)

 

Edited January 23, 2019 by rlx

[Johnc]

Oh yes, that's it, this works great, totally awesome !!

Yes using the highest revision letter is good,

This will save me tons of time.

Thank you very much:)

[rlx]

Glad to help

[Rajat]

I am pasting a lot of data from autocad to excel so i click on text in autocad after that i press and control + C and than on excel box and press control + V i just have to paste a lot of data from autocad to excel and there is a specfic sequence in it so i was wondering if there is any lisp where whenever i click the text it just get copied by itself automatically so i don't have to press control + C all the time and since it's a single text so whenever i click on single text while me MTEXT command is active the whole text get selected but if somehow i just get copy by itself by mean of some sort of Lisp so please help me.