Found a lisp from Tharwat (block quickly)

I found a lisp from Tharwat and as below Web(It is good)

Have any way let block quickly and it don't need to select point?

There are 1000 texts need to create block.

 
; Quick Block
; Creates a block instantly out of the objects that you select
; Found at [url]http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/Quick-block/td-p/3454228[/url]
(defun c:QB (/ selectionset insertionpoint number Blockname)
;;; Tharwat 11. May. 2012 ;;
(if (and (setq selectionset (ssget "_:L"))
(setq insertionpoint (getpoint "\n Specify insertion point :"))
)
(progn
(setq number 1
Blockname (strcat "MyBlock" (itoa number))
)
(while (tblsearch "BLOCK" Blockname)
(setq Blockname
(strcat "MyBlock" (itoa (setq number (1+ number))))
)
)
(command "_.-Block" Blockname insertionpoint selectionset "")
(command "_.-insert" Blockname insertionpoint "" "" "")
)
(princ)
)
(princ)
)

Here's one I use. It doesn't require an insertion point, but it makes anonymous blocks, which may not be what you want because they do not show in Autocad's Block Editor.

Steve

;;; MAKES ANONYMOUS BLOCKS
;;;
(princ "\n This code is provided Unscramnbled - for free - given that it is not altered")
(princ "\n Thanks for your understanding, www.xordesign.com ")
(princ "\n Type TBLOCK to start ")

(defun c:TBLOCK (/ sset tell ent ent_get entu ent_getu blk)
       (princ "\n Select objects to group into anonymous Block: ")
       (setq sset (ssget))
       (if sset (progn
            (entmake (list 
                      '(0 . "BLOCK")
                      '(2 . "*U")
                      '(70 . 1)
                      '(10  0.0 0.0 0.0)))
            (setq tell 0)
            (setq ent (ssname sset tell))
            (while ent
              (setq ent_get (entget ent))
              (if (/= (cdr (assoc 0 ent_get)) "POLYLINE")
                  (progn
                     (setq ent_getu (cdr ent_get))
                     (entdel ent)
                     (entmake ent_getu))
                  (progn
                    (setq entu ent
                          ent_getu (cdr ent_get))
                    (while (/= (cdr (assoc 0 ent_getu)) "SEQEND")
                     (setq ent_getu (cdr (entget entu)))
                     (entmake ent_getu)
                     (setq entu (entnext entu))
                     );while
                     (entdel ent)                   
                  )
              );if
              (setq tell (+ tell 1))
              (setq ent (ssname sset tell))
            )       
            (setq blk (entmake (list '(0 . "ENDBLK"))))
            (entmake (list '(0 . "INSERT")
                            (cons 2 blk)
                            '(10 0.0 0.0 0.0)))  
         );progn
       );if
     (princ "\n Anonymous block created. Explode to ungroup")
       (princ)
)                    
(princ)

Hi Steve

Thanks

For 1000 texts

Can it have 1000 points?The pionts set on every text centor.

Here's one I use. It doesn't require an insertion point, but it makes anonymous blocks, which may not be what you want because they do not show in Autocad's Block Editor.

 

Steve

 

;;; MAKES ANONYMOUS BLOCKS
;;;
(princ "\n This code is provided Unscramnbled - for free - given that it is not altered")
(princ "\n Thanks for your understanding, www.xordesign.com ")
(princ "\n Type TBLOCK to start ")

(defun c:TBLOCK (/ sset tell ent ent_get entu ent_getu blk)
       (princ "\n Select objects to group into anonymous Block: ")
       (setq sset (ssget))
       (if sset (progn
            (entmake (list 
                      '(0 . "BLOCK")
                      '(2 . "*U")
                      '(70 . 1)
                      '(10  0.0 0.0 0.0)))
            (setq tell 0)
            (setq ent (ssname sset tell))
            (while ent
              (setq ent_get (entget ent))
              (if (/= (cdr (assoc 0 ent_get)) "POLYLINE")
                  (progn
                     (setq ent_getu (cdr ent_get))
                     (entdel ent)
                     (entmake ent_getu))
                  (progn
                    (setq entu ent
                          ent_getu (cdr ent_get))
                    (while (/= (cdr (assoc 0 ent_getu)) "SEQEND")
                     (setq ent_getu (cdr (entget entu)))
                     (entmake ent_getu)
                     (setq entu (entnext entu))
                     );while
                     (entdel ent)                   
                  )
              );if
              (setq tell (+ tell 1))
              (setq ent (ssname sset tell))
            )       
            (setq blk (entmake (list '(0 . "ENDBLK"))))
            (entmake (list '(0 . "INSERT")
                            (cons 2 blk)
                            '(10 0.0 0.0 0.0)))  
         );progn
       );if
     (princ "\n Anonymous block created. Explode to ungroup")
       (princ)
)                    
(princ)

Rain0923

See attachment, this is a program, not a lisp.

Unzip the archive, open dwg file, start program, click Start.

TextToBlock.zip

Rain0923,

My understanding was that you wanted to make a single block consisting of all texts in your drawing.

If your objective is to turn each line of text in a drawing into its own separate block, the TBLOCK program I suggested is not the tool for that job.

Steve

Thank you for your help,but this program can't download in my company.

Still thank you!!

Rain0923

See attachment, this is a program, not a lisp.

Unzip the archive, open dwg file, start program, click Start.

Still thank you!!thank you!!

Rain0923,

My understanding was that you wanted to make a single block consisting of all texts in your drawing.

If your objective is to turn each line of text in a drawing into its own separate block, the TBLOCK program I suggested is not the tool for that job.

 

Steve

Thank you for your help,but this program can't download in my company.

Still thank you!!

Why?

Did you watch it?

It does not need to be installed.

Yes watched it at home.

But I just can download file(EX:pdf, doc, xls, ppt, txt)

For exe file,I can't download in my company.

Thank you very much

Thank you very much

Thank you very much

Why?

Did you watch it?

It does not need to be installed.

Flash drive

If I could Iwill but my computer doesn't USB port.:cry:

Thank you!!

Flash drive

Flash drive

Hello maratovich

I tried your program,it's good for me. thank you very much.

By the way, one more question can it create name base on number?

example the text is 1 then blockname is 1 & the text is 2 then blockname is 2.......

I do not understand everything.

Attach an example of how it should be.

I do not understand everything.

Attach an example of how it should be.

Pls try on file.....thanksexample.dwg

I'm very busy right now. I'll check in a week.

Try this one

(defun c:QB2 ( / ss idx inspnt number Blockname itmss itm)
 ;inspired by Quick block from Tharwat (11. May. 2012)
 ;modified to automatically make block from texts in the current layout
 ;by Jef! on 2017-11-17
  (command "._undo" "_be")
  (if (setq ss (ssget "_X" (list '(0 . "TEXT") (cons 410 (getvar 'ctab)))))
      (progn
        (setq number 1
              Blockname (strcat "MyBlock" (itoa number))
              itmss (ssadd)
        )
        (repeat (setq idx (sslength ss))
           (while (tblsearch "BLOCK" Blockname)
                  (setq Blockname (strcat "MyBlock" (itoa (setq number (1+ number)))))
           )
           
           (setq inspnt (cdr(assoc 10 (entget (setq itm (ssname ss (setq idx (1- idx)))))))
                 itmss (ssadd itm)
           )
           (vl-cmdf "_.-Block" Blockname inspnt itmss "")
           (vl-cmdf "_.-insert" Blockname inspnt "" "" "")
        )
      )
  )
 (command "._undo" "_e")
 (princ)
)

You owe 1 beer to Tharwat and 1 beer to me each time you execute it. Deal?

Cheers!

Try this one

 

(defun c:QB2 ( / ss idx inspnt number Blockname itmss itm)
 ;inspired by Quick block from Tharwat (11. May. 2012)
 ;modified to automatically make block from texts in the current layout
 ;by Jef! on 2017-11-17
  (command "._undo" "_be")
  (if (setq ss (ssget "_X" (list '(0 . "TEXT") (cons 410 (getvar 'ctab)))))
      (progn
        (setq number 1
              Blockname (strcat "MyBlock" (itoa number))
              itmss (ssadd)
        )
        (repeat (setq idx (sslength ss))
           (while (tblsearch "BLOCK" Blockname)
                  (setq Blockname (strcat "MyBlock" (itoa (setq number (1+ number)))))
           )

           (setq inspnt (cdr(assoc 10 (entget (setq itm (ssname ss (setq idx (1- idx)))))))
                 itmss (ssadd itm)
           )
           (vl-cmdf "_.-Block" Blockname inspnt itmss "")
           (vl-cmdf "_.-insert" Blockname inspnt "" "" "")
        )
      )
  )
 (command "._undo" "_e")
 (princ)
)

 

You owe 1 beer to Tharwat and 1 beer to me each time you execute it. Deal?

 

Cheers!

Cheers!!It is very good for me,I owe you and Tharwat.Thanks a lot!!

Tharwat script is excelent, but need a little help.. Instead of auto naming, is it possible to select a text or mtext as the block name after specifying the insertion point?

Any help would be appreciated....

Thanks