Text to Attribute and then create Block with it

Hello Again

i have join two great scripts from Lee Mac(txt2att) and Tharwat(qb) )

but i know this could be optimized....

My intention on doing this is to grab existing text (one by one) and transform gave it attributes and after convert to block. So i am asking you guys a couple of things:

1) when creating the attributes i would like the user to be prompt for a blockname and the rest stays as it is

2) after the blockname been introduced it asks for text's, one after one, converting everyone of them into blocks with the same name but different values that the text allready has. is this possible???

if i was not clear enought please say so.

thx in advanced

(defun c:txt2att ( / el i ss st selectionset insertionpoint number Blockname ) (vl-load-com)
 
 (if (setq ss (ssget "_:L" '((0 . "TEXT"))))
   (repeat (setq i (sslength ss))
     (setq el (entget (ssname ss (setq i (1- i))))
           st (vl-string-translate " " "_" (cdr (assoc 1 el)))
     )
     (if
       (entmakex
         (append '((0 . "ATTDEF"))
           (vl-remove-if '(lambda ( pair ) (member (car pair) '(0 100 73))) el)
           (list
             (cons 70  0)
             (cons 74 (cdr (assoc 73 el)))
             (cons  2 st)
             (cons  3 st)
           )
         )
       )
       (entdel (cdr (assoc -1 el)))
     )
   )
 )

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

or if simplier another script that:

1) prompt user select multiple text

2) prompt for existing block name

3) erase text and insert chosen block on text location

4) substitute value of block for previous text content....

am i dreaming too loud ???

regards

can someone at least tell me i am crazy ha!ha!ha!

my goal is to substitute a lot of text's for these blocks so that i can count them.

The thing is that the blocks name repeat but there are many diferent because there are different types of electrical panels in this case.

Sorry if this is too messed up

Regards

You can count text also if you want, just make a selection set then the length is the quantity, you could do also a bit smarter pick all text sort list then just walk through list and compare next text value, when it changes write out the total.

;This is a bit rough but a starting point
(setq ss1 (ssget  (list (cons 0 "TEXT,MTEXT"))))  ;pick text 
(setq len (sslength ss1))
; the len is the number of text

let us know if this is maybe the way to go

Hello Bigal thx for the answer

Well, thats the thing. I have 10 drawing's full of pieces of text that represent different electrical panels.

Ex.

201,202,203,204 that belongs to electric panel QPP1

201,202,402,403,404 that belongs to electrical panel QPP2

and so on....

As you imagine this is a bit tricky to count because some of them are equal but from different electrical panel...

What i want to do is use a pre-made block that is name is the name of the electrical panel (QPP1, QPP2, QS, QE, ect) and substitute the text there:

1) script start and asks for a Block Name (in this case QPP1, QPP2, QS, QE, ect)

2) the user picks existing text (belonging to that particular electrical panel of course)

3) the script reads the value number existing on this text

4) then erases the pre picked text

5) inserts the block chosen

6) changes block value to number value pre-read

p.s. The user is me

p.s.2 this is to me after just use another script or qselect to count and select panel by panel values

p.s.3 and to remain there so that if i alter anything i can count them again and not doing this thing everytime i wanna count them...

p.s.4 my lisp knowledge is almost 0 so

sorry if i am being not clearer. If so just say please

Regards

Hey

I just found this thread : Lisp routine to insert blocks at point locations

i am trying to change the script on post 10/10 (made by Alan J. Thompson) to work with what i want.

i understand that changing line (ssget "_:L" '((0 . "POINT"))) TO (ssget "_:L" '((0 . "TEXT"))) it asks for text but then the script dont get the text coordinates and leaves the script... can you help me?

By the way this script already:

1) script start and asks for a Block Name (in this case QPP1, QPP2, QS, QE, ect)

2) the user picks existing text (belonging to that particular electrical panel of course)

3)....

4) then erases the pre picked text

5) inserts the block chosen

6)....

but still misses:

3) the script reads the value number existing on this text

6) changes block value to number value pre-read

thx in advanced

Hello

i asked HERE also for a solution and Moshe-A gave me one wich i l8ter changed to insert on center mid.

thx you guys anyway

Foun this code in my storage, very little tested, see if this work

(defun C:axbt  (/ *error* acsp adoc align attobj block_coll block_def bname bref
 en hgt msg name names orig pmt sset style tag txtobj txtval val)
 (vl-load-com)
 (defun *error* (msg)
   (if adoc (vla-endundomark  adoc))
   (if
     (and msg
   (not
     (member
       msg
       '("console break"
  "Function cancelled"
  "quit / exit abort"
  ""
 )
     )
   )
     )
      (princ (strcat "\nError: " msg))
   )
   (setvar "nomutt" 0)
   
   
   (princ)
 )
(or adoc
    (setq adoc (vla-get-activedocument
   (vlax-get-acad-object))))
(or acsp
    (setq acsp (if (= (getvar "CVPORT") 1)
   (vla-get-paperspace
     adoc)
   (vla-get-modelspace
     adoc)
   )
   )
    )
(setq block_coll (vla-get-blocks adoc))
(vla-endundomark adoc)
(vla-startundomark adoc)
(while (tblsearch "BLOCK"
    (setq bname (getstring T "\nEnter block name: ")))
  (progn
    (alert "Block already exist, input another name")
    (setq msg "")
    (vlax-for obj  (setq names (vlax-map-collection block_coll 'vla-get-name))
      (setq name (vla-get-name obj))
      (if (not (wcmatch name "`**"))
 (setq msg (strcat msg (vla-get-name obj) "\n"))))
    (alert (strcat "Check existing blocks:\n" msg))))
(setvar "nomutt" 0)
(prompt
  "\nSelect a single text by single pick to get properies from\n")
(setvar "nomutt" 1)
(while (not
  (setq sset (ssget "_:S:L" (list (cons 0 "text")))))
  (alert (strcat "Select text again")))
(setq txtobj (vlax-ename->vla-object (ssname sset 0)))
(setvar "aflags" 4)
(setvar "attreq" 0)
(setvar "attdia" 1)
(setvar "nomutt" 0)
(prompt "\nCreating block with ActiveX method\n")
(setq orig (vlax-get txtobj 'insertionpoint)
      pmt  "Panel type"     ; prompt
      tag  "PANEL_TYPE"     ;tag
      val  (vlax-get txtobj 'textstring)   ;default value
      )
(setq hgt   (vlax-get txtobj 'height)
      style (vlax-get txtobj 'stylename)
      align (vlax-get txtobj 'alignment))
;; add block definition first
(setq block_def (vla-add block_coll (vlax-3d-point orig) bname))
;; change properties of the block definition
(vla-put-blockscaling block_def 1)
(vla-put-blockscaling block_def 1)
(vla-put-units block_def 1) ; possible enums: acInsertUnitsInches, acInsertUnitsUnitless, acInsertUnitsMillimeters, acInsertUnitsMeters, etc
;; add attribute 
(setq attobj (vlax-invoke
 block_def
 'addattribute
 hgt
 acattributemodepreset
 pmt
 orig
 tag
 val))
;; change properties of the attribute
(vlax-put attobj 'alignment align)
(vlax-put attobj 'stylename style)
(vla-put-layer attobj "0")
(vlax-put attobj 'color 0)
(princ "\n")
(if (not (tblsearch "BLOCK" bname))
  (progn
    (alert "Error on  creating blocks")
    (exit)
    (princ))
  (progn
    (setvar "nomutt" 0)
    (prompt "\n\nSelect all texts to convert to blocks\n")
    (setvar "nomutt" 1)
    (if (setq tset (ssget "_:L" (list (cons 0 "text"))))
      (while (setq en (ssname tset 0))
 (setq txtobj (vlax-ename->vla-object en))
 (setq xlist (cons txtobj xlist))
 (setq orig (vlax-get txtobj 'insertionpoint))
 (setq txtval (vla-get-textstring txtobj))
 (setq orig (vlax-get txtobj 'insertionpoint))
 (setq bref (vlax-invoke acsp 'insertblock orig bname 1 1 1 0))
 (foreach attobj  (vlax-invoke bref 'getattributes)
   (if (eq tag (vla-get-tagstring attobj))
     (vla-put-textstring attobj txtval)
     (vla-update attobj))
   )
 (ssdel en tset)
 (entdel en)
 )
      )
    (setvar "nomutt" 0)
    )
  )
(vl-catch-all-apply
  '(lambda () (vlax-release-object block_def)))
(*error* nil)
(princ)
 )   
(princ "\n\t\t   Start command with: AXBT\n")
(prin1)