Text in to Attribute block value

[Antas]

Hi

This is my first post in this awesome forum:). I’ m newbie in drafting

Kindly help me with a lisp program. That

1. Asks the user to select various texts in the drawing
   
2. Places an attribute text over the selected text without replacing them
   
3. Makes an attribute block with that att texts
   
4. The values of the att block should contain the texts
   

Note: the tag name should be following a number system (If I have selected 3 texts then the tag names can be antas1,antas2,antas3 or yourname1,yourname2,yourname3:P)

 

Please help me. Daily I have to spend one hell of time in this work:cry: .

Edited December 30, 2014 by Antas

[pBe]

This will result to a quite a number of blocks, The attribute will show the TEXT string value so why the need for different tag names Antas?

[Antas]

Welcome pBe:)

I need only one Attribute block. The number of tags in the block should be equal to number of text I select. That tag value should contain the string of selected text.

 

The need for different tag name is for documentation reference. It is something we follow to ensure for our future reference.

 

I have attached the sample output file with this post. In that 4 texts ‘Sun’ ‘Earth’ ‘Moon’ ‘Mars’ is exported in to the attribute block named ‘system’ which contains

TAG1 with value Sun,

TAG2 with value Earth,

TAG3 with value Moon,

TAG4 with value Mars.

(Note: the attribute block tags are just over the existing texts.)

 

Sample att.dwg

[Tharwat]

It was fun to write this program and I did write this program to have it for my future use and for some other reasons

 

Try it now and let me know .

 

(defun c:test (/ _doc l name bk sel sn n i p h)
;;;                        ;;;
;;;         Tharwat 30.12.2014        ;;;
;;; -----------------------------------------    ;;;
;;; Converts a selection of Single Texts    ;;;
;;; Objects to Attributed Block            ;;;
;;; -----------------------------------------    ;;;
;;;                        ;;;
 (if
   (and (/= "" (setq name (getstring t "\n Specify Block name :")))
        (if (and (snvalid name)
                 (tblsearch "BLOCK" name)
            )
          (progn
            (alert (strcat "The Block name < "
                           name
                           " > is already existed or not valid name !!"
                   )
            )
            nil
          )
          t
        )
        (princ
          "\n Select TEXT objects to convert to Attributed Block "
        )
        (setq sel (ssget '((0 . "TEXT"))))
        (vla-add
          (vla-get-blocks
            (setq _doc (vla-get-activedocument (vlax-get-acad-object)))
          )
          (vlax-3d-point '(0. 0. 0.))
          name
        )
        (setq bk (vla-item (vla-get-blocks _doc) name))
        (setq n 0)
   )
    (progn
      (repeat (setq i (sslength sel))
        (setq l (cons (list (setq sn (ssname sel (setq i (1- i))))
                            (cdr (assoc 10 (entget sn)))
                            (cdr (assoc 1 (entget sn)))
                      )
                      l
                )
        )
      )
      (setq
        l (vl-sort l
                   '(lambda (j k) (< (cadr (cadr j)) (cadr (cadr k))))
          )
      )
      (mapcar
        '(lambda (lst / o)
           (if (setq o (vla-addattribute
                         bk
                         (cdr (assoc 40 (entget (car lst))))
                         acattributemodelockposition
                         (caddr lst)
                         (vlax-3D-point (cadr lst))
                         (strcat "TAG" (itoa (setq n (1+ n))))
                         (caddr lst)
                       )
               )
             (vla-put-stylename o (cdr (assoc 7 (entget (car lst)))))
           )
         )
        l
      )
    )
 )
 (princ)
)(vl-load-com)

[Antas]

Hi Tharwat,

It asks to enter a block name, then asks to select objects. But once after the selection noting happens...

[Tharwat]

After that invoke the command insert to insert the block

[Antas]

Please forgive this late bloomer

Could you please explain the directions to use this program..

[Tharwat]

Could you please explain the directions to use this program..

 

After you run the program and type a valid New Block Name , and select Single Text Object (s) , then use the command insert to insert the name of the block that the program has just created .

[Antas]

wow, simply great!

.

But one small request, Could you please modify the code as it dont asks me to enter a block name. Coz am going to use this only one time per drawing. So i can make a quick block insert sequence

[Tharwat]

wow, simply great!

 

Cool

 

But one small request, Could you please modify the code as it dont asks me to enter a block name. Coz am going to use this only one time per drawing. So i can make a quick block insert sequence

 

Just replace this part .

 

(/= "" (setq name (getstring t "\n Specify Block name :")))

 

With the following part and change the block name as you want .

 

(setq name [color=magenta]"MyBlock"[/color])

 

Good luck .

[Antas]

Works nice. thanks a lot Tharwat :thumbsup:

[Tharwat]

Works nice. thanks a lot Tharwat :thumbsup:

You are most welcome

[Antas]

Hi Tharwat,

 

there is a small problem:(, the attribute block values created with this code has a text width "1".

But the selected texts have a text width of ".8".

 

Could you please modify the code as it doesn't changes the existing text width.

[Tharwat]

Not a problem at all , try this and let me know

 

(defun c:Test (/ _doc l name bk sel sn n i p h)
;;;                                    ;;;
;;;         Tharwat 30.12.2014                ;;;
;;; -----------------------------------------    ;;;
;;; Converts a selection of Single Texts        ;;;
;;; Objects to Attributed Block                ;;;
;;; -----------------------------------------    ;;;
;;;                                    ;;;
 (if
   (and (/= "" (setq name (getstring t "\n Specify Block name :")))
        (if (and (snvalid name)
                 (tblsearch "BLOCK" name)
            )
          (progn
            (alert (strcat "The Block name < "
                           name
                           " > is already existed or not valid name !!"
                   )
            )
            nil
          )
          t
        )
        (princ
          "\n Select TEXT objects to convert to Attributed Block "
        )
        (setq sel (ssget '((0 . "TEXT"))))
        (vla-add
          (vla-get-blocks
            (setq _doc (vla-get-activedocument (vlax-get-acad-object)))
          )
          (vlax-3d-point '(0. 0. 0.))
          name
        )
        (setq bk (vla-item (vla-get-blocks _doc) name))
        (setq n 0)
   )
    (progn
      (repeat (setq i (sslength sel))
        (setq l (cons (list (setq sn (ssname sel (setq i (1- i))))
                            (cdr (assoc 10 (entget sn)))
                            (cdr (assoc 1 (entget sn)))
                      )
                      l
                )
        )
      )
      (setq
        l (vl-sort l
                   '(lambda (j k) (< (cadr (cadr j)) (cadr (cadr k))))
          )
      )
      (mapcar
        '(lambda (lst / o)
           (if (setq o (vla-addattribute
                         bk
                         (cdr (assoc 40 (entget (car lst))))
                         acattributemodelockposition
                         (caddr lst)
                         (vlax-3D-point (cadr lst))
                         (strcat "TAG" (itoa (setq n (1+ n))))
                         (caddr lst)
                       )
               )
             (progn
               (vla-put-scalefactor
                 o
                 (cdr (assoc 41 (entget (car lst))))
               )
               (vla-put-stylename o (cdr (assoc 7 (entget (car lst)))))
             )
           )
         )
        l
      )
    )
 )
 (princ)
)(vl-load-com)

[Antas]

thats awesome:D

[Tharwat]

thats awesome:D

 

Excellent , good luck

[abra-CAD-abra]

Hi Tharwat,

 

This is a nice routine.

 

Can the code be modified to replace each text entity with a named block in the drawing (the said block containing 1 attribute). The attribute value then becomes that of each text string?

 

This is beyond my lisp knowledge and I am currently using the TCIRCLE command. While this is OK in itself, it is not as versatile as using an attributed block.

 

Thanks in advance.

[Tharwat]

Hi Tharwat,

 

This is a nice routine.

 

 

Thank you .

 

 

Can the code be modified to replace each text entity with a named block in the drawing (the said block containing 1 attribute). The attribute value then becomes that of each text string?

 

This is beyond my lisp knowledge and I am currently using the TCIRCLE command. While this is OK in itself, it is not as versatile as using an attributed block.

 

Thanks in advance.

 

Are you after selecting an attributed block that has ONLY one attribute text string and replace with this text string a set of text strings ( text objects ) ?

Can you extend your idea of the routine a little bit further ?

 

Tharwat

[abra-CAD-abra]

Yes.

 

Specifying the name of a block (with one attribute) contained within the drawing, this block would replace each individual text entity and the attribute value would be the contents of the text entity being replaced.

 

Eg. Block Name: 'TRECT' Tag: 'TRID'

 

So, for the first text entity found:

 

First text entity (String contents > "MC-01") Replace with Block 'TRECT' > Attribute Value = "MC-01" for Tag 'TRID'

 

Second text entity found (String contents > "DZ-03") Replace with Block 'TRECT' > Attribute Value = "DZ-03" for Tag 'TRID'

 

..and so on...

 

For each individual text entity found.

 

I think the block name and tag name would be variables (Setq).

 

Many thanks.

[Tharwat]

Something like this ?

 

(defun c:Test  (/ *error* _doc s ss i v )
;;;        Tharwat 13.01.2015        ;;
 (defun *error*  (msg)
   (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))
     (princ (strcat "\n** Error: " msg " **"))
     )
   (princ)
   )
 (if
   (and
     (princ
       "\n Pick Text ..."
       )
     (setq s (ssget "_+.:S:E" '((0 . "TEXT,MTEXT"))))
     (princ "\n Select Attributed blocks ...")
     (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
     (setq v (cdr (assoc 1 (entget (ssname s 0)))))
     )
    (progn
      (vla-startUndomark
        (setq _doc (vla-get-activedocument (vlax-get-acad-object)))
        )
      (repeat (setq i (sslength ss))
        (mapcar
          '(lambda (a) (vla-put-textstring a v))
          (vlax-invoke
            (vlax-ename->vla-object (ssname ss (setq i (1- i))))
            'getattributes
            )
          )
        )
      (vla-endUndomark _doc)
      )
    )
 (princ)
 )(vl-load-com)

Edited January 14, 2015 by Tharwat