Found a lisp from Tharwat (block quickly)

August 25, 2017

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)
)

August 25, 2017

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)

August 25, 2017

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)

August 25, 2017

Rain0923

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

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

TextToBlock.zip

August 26, 2017

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

August 30, 2017

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.

August 30, 2017

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

August 30, 2017

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.

August 30, 2017

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

Why?
Did you watch it?

It does not need to be installed.

August 30, 2017

Flash drive

August 31, 2017

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

Thank you!!

Flash drive

November 14, 2017

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.......

November 14, 2017

I do not understand everything.

Attach an example of how it should be.

November 15, 2017

I do not understand everything.
Attach an example of how it should be.

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

November 17, 2017

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

November 17, 2017

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!

November 21, 2017

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!!

April 14, 2018

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

Sign In

Found a lisp from Tharwat (block quickly)

Recommended Posts

Rain0923

StevJ

Rain0923

maratovich

StevJ

Rain0923

Rain0923

maratovich

Rain0923

maratovich

Rain0923

Rain0923

maratovich

Rain0923

maratovich

Jef!

Rain0923

muhsinos

Join the conversation

Tutorials

Forums

Activity