Convert text into an attribute and import it to a block via a LISP routine
You can try ALTEXT. It can use a customized formula to handle block attributes.
Original texts and block inserts - texts are around block inserts:
Step 1
Save the codes in Example 11 of ALTEXT Formula as a "lsp" file and load ALTEXT.vlx.
Step 2
Ensure the block has an attribute. You can redefine the block and use BATTMAN if necessary.
Step 3
Select one block and "Select similar" from the short-cut menu.
Step 4
Run ALTEXT and tick the "Use formula" option. Select the lsp file saved in Step 1 as the formula.
Result.
@Anonymous wrote:
.... drawings that contain blocks but the information related to the blocks is written either in text or mtext format...
The big question in my mind is whether those rectangles in your image are multiple Insertions of the same Block name. [We can't tell from an image.] If so, then I suspect you don't want to take a nearby piece of Text/Mtext, convert it to an Attribute, and integrate it into the Block, because after that has happened once, the next one will be adding a second Attribute into the same Blockdefinition, and the next one a third, etc. That concern argues for something like @3wood's suggestion to give the Block an Attribute [one time], and let the process be to take the text content from the nearby Text/Mtext object, and assign that to the Attribute that's already in the Block.
Kent Cooper, AIA 
- Is the target block already have an attribute defiintion
--- YES
------ is it on the same spot as text or anywhere near it?
--- NO: Do you already have a the block attribute for replacement?
------ YES: Use Express Tool "BLOCKREPLACE"
------ NO:Do you want to inherit the TEXT properties?
--------- YES:
--------- NO: Please specify height. style etc...
More importantly
Would it be possible to post a sample drawing file and not just an image?
Accepted solution
@Anonymous wrote:
Hello @pbejse
I have tried to upload a sample file.
The blocks don't have defined attributes at the moment.
I don't have a block attribute ready for replacement.
Yes I want to inherit the text properties.
...
Try this:
(defun c:Text2AttB (/ ss i TheSelectedTextObject ll ur blk l sstext dataFromSelectedBlockObject
dataIneedFromSelectedBlockObject entText)
(if (and
(setq ss (ssget "_:L" '((0 . "INSERT"))))
(setq fuzz (getreal "\nEnter Fuzz factor: "))
)
(repeat (setq i (sslength ss))
(setq blk (ssname ss (setq i (1- i))))
(setq dataFromSelectedBlockObject (entget blk))
(setq dataIneedFromSelectedBlockObject
(mapcar
(function
(lambda (dxfcodes)
(assoc
dxfcodes
dataFromSelectedBlockObject
)
)
)
'( 2 8 10 50 41 42 43 50 )
)
)
(Vla-getboundingbox (vlax-ename->vla-object blk) 'll 'ur)
(setq ll (vlax-safearray->list ll)
ur (vlax-safearray->list ur) cnt 0)
(While (and (< cnt 10)
(not (setq sstext (ssget "C" ll ur '((0 . "TEXT"))))))
(setq ur (polar ur (* pi 0.25) (* fuzz (sqrt 2)))
ll (polar ll (* pi 1.25) (* fuzz (sqrt 2))) cnt (1+ cnt))
)
(if
sstext
(progn
(setq entText (entget (ssname sstext 0)))
(setq dataIneedFromSelectedTextObject
(mapcar
(function
(lambda (dxfcodes)
(assoc
dxfcodes
entText
)
)
)
'(1 40 7 10 50 41 8)
)
)
(entmake
(append
(list '(0 . "INSERT") '(66 . 1))
dataIneedFromSelectedBlockObject )
)
(entmake
(append
(list '(0 . "ATTRIB")
'(2 . "TAG")
'(70 . 0)
)
(cons '(1 . "-") (Cdr dataIneedFromSelectedTextObject))
)
)
(entmake '((0 . "SEQEND")))
(entdel (ssname sstext 0))
(Vla-put-textstring
(car (vlax-invoke
(vlax-ename->vla-object (entlast))
'GetAttributes
)
)
(Cdr (Car dataIneedFromSelectedTextObject))
)
)
)
)
)
(princ)
)
I tested this on the drawing sample, a fuzz factor of 10. missed 3 items, 20 missed 1, and 30 is just right.
So it really depends on how far the TEXT. you should be able to play with fuzz value.
Hope this helps
@Anonymous wrote:
.... Your LISP incorporates only REC100 as an attribute and leaves out REC200 (it should be a second attribute). These are the 10-20 texts I am missing...but its ok I can do it manually.,,
(defun c:Text2AttB (/ ss i TheSelectedTextObject ll ur blk l sstext dataFromSelectedBlockObject
dataIneedFromSelectedBlockObject entText)
(if (and
(setq ss (ssget "_:L" '((0 . "INSERT"))))
(setq fuzz (getreal "\nEnter Fuzz factor: "))
)
(repeat (setq i (sslength ss))
(setq blk (ssname ss (setq i (1- i))))
(setq dataFromSelectedBlockObject (entget blk))
(setq dataIneedFromSelectedBlockObject
(mapcar
(function
(lambda (dxfcodes)
(assoc
dxfcodes
dataFromSelectedBlockObject
)
)
)
'( 2 8 10 50 41 42 43 50 )
)
)
(Vla-getboundingbox (vlax-ename->vla-object blk) 'll 'ur)
(setq str nil
ll (vlax-safearray->list ll)
ur (vlax-safearray->list ur) cnt 0)
(While (and (< cnt 10)
(not (setq sstext (ssget "C" ll ur '((0 . "TEXT"))))))
(setq ur (polar ur (* pi 0.25) (* fuzz (sqrt 2)))
ll (polar ll (* pi 1.25) (* fuzz (sqrt 2))) cnt (1+ cnt))
)
(if
sstext
(progn
(entmake
(append
(list '(0 . "INSERT") '(66 . 1))
dataIneedFromSelectedBlockObject )
)
(repeat (Setq n (sslength sstext))
(setq entText (entget (ssname sstext (setq n (1- n)))))
(setq dataIneedFromSelectedTextObject
(mapcar
(function
(lambda (dxfcodes)
(assoc
dxfcodes
entText
)
)
)
'(1 40 7 10 50 41 8)
)
)
(setq str (cons (cdr (car dataIneedFromSelectedTextObject)) str))
(entmake
(append
(list '(0 . "ATTRIB")
(cons 2 (Strcat "TAG" (itoa (1+ n))))
'(70 . 0)
)
(cons '(1 . "-") (Cdr dataIneedFromSelectedTextObject))
)
)
(entdel (ssname sstext n))
)
(entmake '((0 . "SEQEND")))
(mapcar 'vla-put-textstring
(vlax-invoke (vlax-ename->vla-object (entlast))
'GetAttributes
)
(reverse str))
)
)
)
)
(princ)
)
@Anonymous wrote:
One more thing :
Is there a way to export all these blocks in a csv list file that will contain the following columns:
Block Name │ Handle │ Insertion_Point_Coordinates(X_Y_Z) │Rotation Angle │Attribute_TAG1 │Value_TAG1 │Attribute_TAG3 │ Value_TAG2
Try DATAEXTRACTION, if that doesnt work for you, the come back and we will sort it out.
HTH
Accepted solution
(defun c:GiveMeYourData ( / _sort addtolist _concatenate opf ss csvFile e data atrb AllData)
(defun _concatenate (lst)
(apply 'strcat (mapcar '(lambda (st)
(strcat st ",")) lst ))
)
(Defun _sort (s l) (vl-sort l '(lambda (a b)(< (s a)(s b)))))
(defun addtolist ( key val lst / old )
(if (setq old (assoc key lst))
(subst (append old (list val)) old lst)
(cons (list key val) lst)
)
)
(if (And
(setq ss (ssget "_X" '((0 . "INSERT")(66 . 1))))
(setq csvFile (getfiled "Output File" "" "csv" 1))
)
(progn
(repeat (setq i (sslength ss))
(setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
(setq data (mapcar '(lambda (p)(vlax-get e p))
'("EffectiveName" "Handle" "InsertionPoint" "Rotation"))
atrb (_sort car (mapcar '(lambda (at)
(list (vla-get-tagstring at)(vla-get-textstring at)))
(vlax-invoke e 'GetAttributes)))
)
(setq AllData (addtolist (car data) (append (Cdr data) atrb) AllData))
)
(setq opf (open csvFile "w"))
(setq AllData (_sort car AllData))
(while (setq a (car AllData))
(Foreach itm (cdr a)
(write-line
(_concatenate
(apply 'append
(list
(list (car a)(car itm))
(mapcar 'rtos (Cadr itm))
(list (rtos (/ (* (Caddr itm) 180.0) pi) 2 0))
(apply 'append (cdddr itm))
)
)
)
opf
)
)
(setq AllData (cdr AllData))
)
(Close opf)
(startapp "explorer" csvFile)
)
)(princ)
)HTH
@nbortolussi wrote:
How can i get it so that it doesnt copy the blocks and instead modifies the blocks i selected?
...
Definitely doable
@nbortolussi wrote:
so far this lisp is the closest i have gotten to what i need. I just posted my question yesterday,
You're referring to this post? replace multiple point objects with block and add nearest text as block attribute