Text2Block

[MS13]

Hello again

 

I need a routine which turn text into block. Rotation  and insert point of the block would be the same as rotation of text is. Name of the blocks is not important, could be text1, text2, ..., text3312. Important is that single text becomes single block and that routine could be applied for whole texts in the drawing

[rlx]

without example not clear if each  block should get unique number. Even less clear why on Mars one would convert text to block? against better judgement (no good deed goes unpunished):

(defun c:t1 ( / wai n a ss bi ba bo c to r s)
  (defun wai (b n v) (vl-some '(lambda (x)(if (= (strcase n)(strcase (vla-get-tagstring x)))
        (progn(vl-catch-all-apply 'vlax-put-property (list x 'MTextAttribute -1))(vla-put-textstring x v))))
                              (vlax-invoke b 'getattributes)))
  (if (not (tblsearch "block" (setq n "txtblk")))
    (mapcar 'entmake '(((0 . "BLOCK")(2 . "txtblk")(70 . 2)(10 0.0 0.0 0.0)) ((0 . "ATTDEF")(8 . "0") (10 0.0 0.0 0.0)(1 . "-")
                       (2 . "txt1")(3 . "text 1")(40 . 2.0)(41 . 1.0)(50 . 0.0)(70 . 0)(71 . 0)(72 . 4)(73 . 2))((0 . "ENDBLK")))))
  (setq a (vla-get-activedocument (vlax-get-acad-object)) c 1 ba "txt1")
  (if (and (setq ss (ssget "x" '((0 . "TEXT"))))  (setq ss (vla-get-activeselectionset a))(tblsearch "block" n))
    (vlax-for to ss
      (setq bi (vla-get-insertionpoint to) s (vla-get-textstring to) r (vla-get-rotation to))
      (vla-delete to) (setq bo (vla-insertblock (vla-get-ModelSpace a) bi n c c c r))(wai bo ba s)))
  (if ss (vl-catch-all-apply 'vlax-release-object (list ss)))
  (vla-regen a acActiveViewport)
  (princ)
)

untested (obviously)

[Tharwat]

Hi @RLK

Good idea to go with attributed than having each single text as a block but if any of the texts reside in paper space then it would be replaced with attributed block in Model space and not in the original space. 

[MS13]

I need to upload dwg to different software and export it after. Exporting changes text elevations to zero, but not a blocks. That is why I need to turn texts to block.

rlx your routine works but not enough. Lisp turn texts to block with unique name, but changes layer to current layer, changes size of font and after exploding block content of text changes 

[rlx]

1 hour ago, Tharwat said:

Hi @RLK

Good idea to go with attributed than having each single text as a block but if any of the texts reside in paper space then it would be replaced with attributed block in Model space and not in the original space. 

 

you're right Tharwat (but maybe it's not a problem )

 

think OP wants to prevent text from being modified. Locked layer would be one way , converting a million text objects to a million blocks would be another (although my text editor , VT doesn't care about text objects) If someone really wants to mess things up he or she (or it) will always find a way.

[rlx]

2 minutes ago, MS13 said:

I need to upload dwg to different software and export it after. Exporting changes text elevations to zero, but not a blocks. That is why I need to turn texts to block.

rlx your routine works but not enough. Lisp turn texts to block with unique name, but changes layer to current layer, changes size of font and after exploding block content of text changes 

 

you didn't specify layer and size where important so didn't include them. This first routine also uses attribute rather than text object so after exploding you're left with an attribute definition. Was already working on plan b that does copy size and layer (cause I already suspected you were going to ask this) but on my side of this planet it's getting late so probably post 2morrow

[rlx]

(defun c:t2 ( / _ubn a bn ss o bi s r h bo spc l)
  (vl-load-com)(setq a (vla-get-activedocument (vlax-get-acad-object)) spc (vla-get-block (vla-get-activelayout a)))
  (defun _ubn ( $bn / b n)(setq n 0)(while (tblsearch "block" (setq b (strcat $bn "_" (itoa (setq n (1+ n))))))) b)
  (if (and (setq ss (ssget "x" '((0 . "TEXT"))))(setq ss (vla-get-activeselectionset a)))
    (vlax-for o ss
      (setq bi (vla-get-insertionpoint o) s (vla-get-textstring o) r (vla-get-rotation o)
            h (vla-get-height o) l (vla-get-layer o) bn (_ubn "txtblk"))
      (mapcar 'entmake (list (list '(0 . "BLOCK")(cons 2 bn) '(70 . 2) '(10 0.0 0.0 0.0))
                             (list '(0 . "TEXT") (cons 8 l) '(10 0.0 0.0 0.0)  (cons 40 h) '(41 . 1.0) '(50 . 0.0)(cons 1 s))
                             (list '(0 . "ENDBLK"))))
      (if (not (vl-catch-all-error-p (setq bo (vl-catch-all-apply 'vla-insertblock (list spc bi bn 1 1 1 r)))))
        (vla-delete o)(prompt "\nError inserting text block"))))
  (if ss (vl-catch-all-apply 'vlax-release-object (list ss)))
  (vla-regen a acActiveViewport)
  (princ)
)

 

[Tharwat]

Hi,

Please try the following program and be sure is that all layers aren't locked in prior of running the program.

(defun c:Test ( / doc bks str ins tmp int blk)
  ;;	Tharwat - 04.Mar.2019		;;
  ;;------------------------------------;;
  ;; convert each single text object to	;;
  ;; a separate block then insert it in	;;
  ;; its related original space.	;;
  ;;------------------------------------;;
  (and (setq doc (vla-get-activedocument (vlax-get-acad-object))
             bks (vla-get-blocks doc)
             )
       (vlax-for lay (vla-get-layouts doc)
         (vlax-for obj (vla-get-block lay)
           (and (= (vla-get-objectname obj) "AcDbText")
                (vlax-write-enabled-p obj)
                (setq str (vla-get-textstring obj)
                      ins (vlax-get obj 'insertionpoint)
                      tmp str
                      int 0)
                (progn (while (tblsearch "BLOCK" tmp) (setq tmp (strcat str "(" (itoa (setq int (1+ int))) ")"))) t) 
                (setq blk (vlax-invoke bks 'add (trans ins 1 0) tmp))
                (vlax-invoke doc 'copyobjects (list obj) blk)
                (vlax-invoke (vla-get-block lay) 'insertblock (trans ins 0 1) tmp 1.0 1.0 1.0 (vla-get-rotation obj))
                (vla-delete obj)
                )
           )
         )
       )
  (princ)
  ) (vl-load-com)

 

[rlx]

nice one Tharwat , hadn't considered the add / copy method.

[Tharwat]

16 minutes ago, rlx said:

nice one Tharwat , hadn't considered the add / copy method.

Thank you.  

[Tharwat]

@rlx

Sorry off topic question:

How come your last appear was in 12 hours ago but you replied in a few minutes a go? What a great software of the forum.   

 

Edited March 4, 2019 by Tharwat

[rlx]

I noticed this weekend I didn't receive any email alerts and then site went down for maintenance on sunday morning so I think it has something to do with this. Also just received a couple of email alerts from one or two days ago so me think system is being flushed right now...

 

p.s. what if textstring contains special characters?

Edited March 4, 2019 by rlx

[notredave]

Tharwat,

 

I'm interested in this lisp routine but I receive this error when I initiate.

 

Command: TEST
; error: AutoCAD.Application: Calling method SetObjectId of interface IAcadBaseObject failed
 

[Tharwat]

Hi,

It seems that you have an  issue with your vl-functions with your CAD program or so if I am not mistaken but to rewrite the codes with AutoLISP  vanilla should make it working as if you are using the same program that I wrote above.

[notredave]

Tharwat,

I use many other lisp routines that use vl-functions that work but this one doesn't work for me. I am using Autocad 2016 if that makes any difference. Oh well, I appreciate the response. Thank you.

[rlx]

it might help if you load Tharwat's code tru the vlisp editor with debug enabled so you can at least see which line causes the error. Maybe replace some vlax-invoke's with vl-catch-all-apply's ? I've tested it with Acad2017 and no problem here...

[Roy_043]

The issue may be that not all texts are valid blocknames.

[rlx]

yeah i posted that in the p.s. from my post on march 4...

 

maybe like this? (untested)

(defun c:Test ( / doc bks str ins tmp int blk)
  ;;    Tharwat - 04.Mar.2019        ;;
  ;;------------------------------------;;
  ;; convert each single text object to    ;;
  ;; a separate block then insert it in    ;;
  ;; its related original space.    ;;
  ;;------------------------------------;;
  (and (setq doc (vla-get-activedocument (vlax-get-acad-object))
             bks (vla-get-blocks doc)
             )
       (vlax-for lay (vla-get-layouts doc)
         (vlax-for obj (vla-get-block lay)
           (and (= (vla-get-objectname obj) "AcDbText")
                (vlax-write-enabled-p obj)
                (setq str (vla-get-textstring obj) ins (vlax-get obj 'insertionpoint) tmp str  int 0)
                (progn (while (tblsearch "BLOCK" tmp) (setq tmp (strcat str "(" (itoa (setq int (1+ int))) ")"))) t)
                (snvalid (setq tmp (vl-string-translate ":;*?,<>/\\|=" "_" tmp))) ; convert invalid characters
                (setq blk (vlax-invoke bks 'add (trans ins 1 0) tmp))
                (vlax-invoke doc 'copyobjects (list obj) blk)
                (vlax-invoke (vla-get-block lay) 'insertblock (trans ins 0 1) tmp 1.0 1.0 1.0 (vla-get-rotation obj))
                (vla-delete obj)
                )
           )
         )
       )
  (princ)
  ) (vl-load-com)

Edited March 18, 2019 by rlx

[Roy_043]

@rlx

Aha, sorry I missed that remark.

 

Note 1:

According to BricsCAD (the program I use) two additional characters are not allowed in blocknames: " and `.

"<>/\\\":?*|,=`;"

Note 2:

The code in this topic will not handle text with a 'random' OCS properly.

[Truski]

Hello everybody.
The last code put works very well for me, but I would like a few more things, if it can be ...
The block can be annotative 1: 1?
The block match orientation to layout?

Thank you