automatic put value in to attribute block.

[Bin2009]

I have batch of text on the drawing, now I need put the value of those each text in to attribute block, is any lisp can help with that, I want to save time on copy and paste value in to attribute block.

For example, on the drawing, I have 10 number for different chainage, -0+125.8, -0+131.6,+0+025.3 …

Now I have 10 attribute blocks, which have tag named CHAINAGE, I want to click the text -0+125.8, then click the block, the value -0+125.8 can be put in the tag CHAINAGE.

Thanks!

Bin

[krzysztof.psujek · Accepted solution]

Hi, try if this what you need

just simple pick text/mtext/mleader/dimension to copy its content and then pick block with CHAINAGE tag.

Regards,

Chris

(prompt "\nType STR2STA to invoke. ")
(defun c:str2sta (/ ent txt blk tag)
  (vl-load-com)
  (setq tag "CHAINAGE")
  (while (setq ent (car (entsel "\nPick text/mtext to copy its content: ")))
    (setq txt (LM:UnFormat (LM:gettextstring ent) nil))
    (if	(setq blk (car(entsel (strcat "\nPick blk to set its " tag " value."))))
      (progn
	(setq blk (vlax-ename->vla-object blk))
	(if (attdef-p (vla-get-name blk) tag)
	  (LM:vl-setattributevalue blk tag txt)
	  (princ (strcat "\nIt's not a block or it hasn't attrib with " tag " tag. "))
	)
      )					;progn
      (princ "\nNothing selected. ")
    )
  )
  (princ "\nThere's no text to copy. ")
  (princ)
)

;;subfunctions

;;  written by hmsilva                     
;; (attdef-p "YoutBlockName" "YourAttTag")
;; If true returns T otherwise nil

(defun attdef-p (blkname tag / a b e)
  (if (setq b (tblobjname "block" blkname))
    (while
      (and
        (setq b (entnext b))
        (setq e (entget b))
      )
       (if (and (= (cdr (assoc 0 e)) "ATTDEF")
                (= (cdr (assoc 2 e)) tag)
           )
         (setq a T)
       )
    )
  )
  a
  )

;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:vl-setattributevalue ( blk tag val )
    (setq tag (strcase tag))
    (vl-some
       '(lambda ( att )
            (if (= tag (strcase (vla-get-tagstring att)))
                (progn (vla-put-textstring att val) val)
            )
        )
        (vlax-invoke blk 'getattributes)
    )
)
;;-------------------=={ 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 )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (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
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr 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
            )
        )
    )
)
(vl-load-com)

;(LM:UnFormat "{\\O\\C1;L\\C256;ee} {\\L\\C2;M\\C256;ac}" nil)
;"Lee Mac"

;;--------------------------------------------------------------------------------

;; Get Textstring  -  Lee Mac
;; Returns the text content of Text, MText, Multileaders, Dimensions & Attributes

(defun LM:gettextstring ( ent / enx itm str typ )
    (setq enx (entget ent)
          typ (cdr (assoc 0 enx))
    )
    (cond
        (   (wcmatch typ "TEXT,*DIMENSION")
            (cdr (assoc 1 (reverse enx)))
        )
        (   (and (= "MULTILEADER" typ)
                 (= acmtextcontent (cdr (assoc 172 (reverse enx))))
            )
            (cdr (assoc 304 enx))
        )
        (   (wcmatch typ "ATTRIB,MTEXT")
            (setq str (cdr (assoc 1 (reverse enx))))
            (while (setq itm (assoc 3 enx))
                (setq str (strcat (cdr itm) str)
                      enx (cdr (member itm enx))
                )
            )
            str
        )
    )
)
;;example usage
(princ)

  

[Bin2009]

Thank very much, this works great!