Insert a block based on anothers attrib insertion

[shadow]

ok where would i start lsp wise to make a lisp that given a block and either the contents of or tag name of an Attribute would insert said block at that attributes insertion point??

any ideas of where to start or how to go about getting the attributes insertion point with out exploding the block if everyone helps everybody the world will be a better place

 

[Striker]

To access an attribute attached to a block, you must first find the block, extract the entity name of the block, step up to the next entity following the block (entnext blk_name)

This should be the attribute entity name, then entget the list i.e.

(entget att_name)

Now you can look at the dxf group codes 1,2,3,10 & 11

If the group codes of 1,2 & 3 match the attribute you are looking for, then use the dxf code 10 for the insertion point of the new block. If the attribute is a justified entity (other than left justify) then use the dxf code 11 for the insertion point.

So...

(defun C:InsertAtAtt( / att_list )
(setq att_name (entnext (car (entsel))))
(while (not att_list)
(setq att_list (entget att_name))
(setq tag (cdr (assoc 1 att_list))
val (cdr (assoc 2 att_list))
prm (cdr (assoc 3 att_list))
a10 (cdr (assoc 10 att_list))
a11 (cdr (assoc 11 att_list))
)
(if (and (= tag "this_value&quot
(= val "this_value&quot
(= prm "this_value&quot
)
(command "_.insert" "block_name" a10 "" "" "&quot
(setq att_list nil)
)
)
)

 

[shadow]

Will the attributes settings make a diference i mean like what if the case is that the attribute is set to constant and invisible if everyone helps everybody the world will be a better place

 

[Striker]

If the attribute is constant and invisible, then the attribute is treated as an entity in the block rather than an attached entity. The above code won't work with that scenario.

 

[shadow]

So what can i do can i tell it to look for specifically invisible constant attribs the main reason i have them as such is i dont want them seen or printed but they may need to be extractable later if everyone helps everybody the world will be a better place

 

[Striker]

You can make the attribs invisible and still access them from the above code, however once you make them constant, they are treated much like text in a block and you cannot access them using the code I provided above. I suggest making the arribs invisible but not constant, however you will have to answer the prompt when you insert the block.

If you read the block definition from the block symbol table then filter out the entities until you find the invisible/constant attribute, then apply the coordinate of that attribute to the insertion point of that block (adding the X to X, Y to Y, and Z to Z) and rotation of the insert, then you can extrapolate the position of the constant attribute and hence insert another block at that position.

 

[shadow]

ok well striker what if the blocks are not just blocks by them selves what if they are an AEC_MVBLOCK_REF which are the multiview block created in ADT but i want to be able to access both... by the way im using ADT 3.3

can i do a ssget and filter by object type/name???
im confusing myself maybe u can clairify all im wanting is to give the name of the block or by selecting one then have it look at the attribs and use a specific attrib tag/value/prompt use that attribs insert pnt does this make sence to you
i have been trying to get a good example of the ssget x deal so that it makes a selection set of all the blocks and allow me to filter by name of block or am i going the wrong way

???Which is the easiest, fastest, least difficult??? if everyone helps everybody the world will be a better place

 

[Striker]

OK, lets see if we can take this one step at a time.....

The blocks are multiview blocks created in ADT... they still should be accessable through the block definition table. You can then still step through the definition to get the attribute insertion point if in fact it is invisible and constant. I would still recommend changing to invisible but non constant ... it seems easier that way.

To select all objects in the drawing based on specific criteria it is preferable to use the ssget "x" function call. The correct syntax for using ssget "x" is as follows:

Create a list of entity data (excluding xdata) that you want to filter by i.e. entity name, text value, entity type, layer, color etc....

for example:

(setq filter_list (list (cons 0 "TEXT&quot(cons 8 "LAYER1&quot))

You can specify any of the group codes if you know the value you are looking for and the DXF group code.

Now you can apply that filter to a selection set of all the entities in the drawing as follows:

(setq selection_set (ssget "x" filter_list))

You can also just quote the list in the ssget function as well:

(setq selection_set (ssget "x" '((0 . "TEXT&quot(8 . "LAYER1&quot)))

Case is insensitive for groups 0 and 8, but you must specify exactly groups 1,2,3 & 4

This will return a selection set of all entities in current space that are text entities on layer1

Keep in mind that (ssget "x" '((0 . "ATTRIB&quot)) will return nil regardless of the number of attributes in the drawing since the attributes are actually considered part of the complex insert to which they are attached, similar to the way a vertice is appended to a polyline entity. To access entities you must entnext the "parent" complex entity to retrieve the attached attributes excepting constant attributes of course.

I hope this sheds a bit more light on the subject

 

[shadow]

Yea i got one line of code no error

(Setq blknms (ssget "X"'(0. "AEC_MVBLOCK_REF&quot(0. "BLOCK REFERENCE&quot)

bout time i say
ok so this collects the names of the AEC_MVBLOCK_REF & BLOCK REFERENCE so u were saying that i need to use entnext to step thru and get the attrib stuff ok so do i start a new line and call out the variable or how do i do it let me give it a shot on what i should do

(Setq blknms (ssget "X"'(0. "AEC_MVBLOCK_REF&quot(0. "BLOCK REFERENCE&quot)
(setq blkatt (entget (entnext (entnext (ssget ":E" '(2 . "ATTRIB&quot)blknms))))
(setq att_name (entnext (car (entsel))));Variable ATT_NAME that returnes the name of entities in the list of objects selected
(while (not att_list); continues searching untill ATT_NAME Variable Is done collecting names
(setq att_list (entget att_name));Variable ATT_list
(setq tag (cdr (assoc 1 att_list));Variable TAG
val (cdr (assoc 2 att_list));Variable VAL
prm (cdr (assoc 3 att_list));Variable PRM
a10 (cdr (assoc 10 att_list));Variable A10
a11 (cdr (assoc 11 att_list));Variable A11
)
(if (and (= tag "this_value&quot
(= val "this_value&quot
(= prm "this_value&quot
)
(command "_.insert" "block_name" a10 "" "" "&quot
(setq att_list nil)
)
)
)

Does that look about right i thought that maybe i could still use the bit of code u gave me and incorperate it i think i might have quite a fe mistakes but this was just a stab at it ya know if everyone helps everybody the world will be a better place

 

[Striker]

I am not sure if the code you have edited will return the constant attribute, I don't believe it will and I am not where I can test it. You can read the block definition from the block table by retrieving the block name (dxf -1) from the symbol table ...

(setq blkname (cdr (assoc -1 (tblsearch "block" "AEC_MVBLOCK_REF&quot))

Then you can entnext the variable blkname until you retrieve the desired entity (presumably a constant hidden attribute)

 

[shadow]

Hmmm well uhh im lost here is what i have snd im not sure that it is doing anything at all
(Defun C:InsertATATT ( / blknames blkatt blkattdef att_name att_list)
(setq blkname (cdr (assoc -1 (tblsearch "block" "AEC_MVBLOCK_REF&quot)))
(setq att_name (entnext (car (blkname))));Variable ATT_NAME that returnes the name of entities in the list of objects selected
(while (not att_list); continues searching untill ATT_NAME Variable Is done collecting names
(setq att_list (entget att_name));Variable ATT_list
(setq tag (cdr (assoc 1 att_list));Variable TAG
val (cdr (assoc 2 att_list));Variable VAL
prm (cdr (assoc 3 att_list));Variable PRM
a10 (cdr (assoc 10 att_list));Variable A10
a11 (cdr (assoc 11 att_list));Variable A11
)
(if (and (= tag "this_value&quot
(= val "this_value&quot
(= prm "this_value&quot
)
(command "_.insert" "block_name" a10 "" "" "&quot
(setq att_list nil)
)
)
)

does not ask for input like block name attrib tag nothing well let me know where im going wrong or what direction i nee to go hey also take a look at the other post i did on lsp defaults i didnt understand quite what he was talking about something about variables that dont destroy??? i dunno maybe you can elaborate for me if everyone helps everybody the world will be a better place

 

[shadow]

Hey found this in an old lisp library and it deals alot with attribs thought the code might be usefull

;|
; Michael Weaver
; Alascad
; 1073 Badger Road
; Fairbanks, Alaska 99705
; Email:mikeweaver_ak@hotmail.com
; Voice and fax (907)488-3577
; (c)1996, 1997, 1998 Michael Weaver
;
; Revision History
; 3/2/92 Added c:repatt function.
; 10/8/92 Added c:ate and c:atm functions
; 5/30/98 Added c:athm function
; 8/3/98 Added c:attpresuf
;ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
;
; (REPATT) REPlace ATTributes globally
; Environment: autocad release 10 or later
; Function: repatt
; Purpose: Repatt will search for all occurrances of a given block
; and search all attributes within those blocks for a
; given attribute value and replace each occurance with a
; new a specified value.
;
; Syntax: (repatt block old new)
; Where the arguments have the following values
; block the name of the block to search
; old the attribute value to be replaced
; new the new attribute value
;
;
; Included functions block to act on old string new string
; c:nodash prompts user - <null>
; c:repatt prompts user prompts user prompts user

; c:atem select a sample attribute, select subject blocks
; specify the new attribute value.

; c:attpresuf add a prefix and/or suffixe to multiple attributes
|;

;;;ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
(defun repatt ( ;REPLACE ATTRIBUTES GLOBALLY
block ;name of block to scan
old ;old attribute value to search for
new ;new attribute value
/ ;end of formal argument list
ss1 ;selection set of blocks
indx1 ;index to ss1 for current block
ent ;entity name for current block
elist ;entity list for current block
ent1 ;entity name for current sub-entity
attflag ;attributes follow flag for current block
elist1 ;entity list for current sub-entity
etype1 ;entity type for current sub-entity
current ;attribute value for current attribute
) ;end of local variable list
(setq ss1 (ssget &quot;x&quot; (list (cons 2 block))))
(if ss1
(progn
(setq indx1 -1)
(while (< (setq indx1 (1+ indx1)) (sslength ss1))
;while blocks in selection set
(setq
ent (ssname ss1 indx1)
ent1 ent
elist (entget ent)
attflag (if (assoc 66 elist)
T
nil
) ;_ end of if
) ;_ end of setq
(if attflag
(progn ;block has attributes
(setq
ent1 (entnext ent1)
elist1 (entget ent1)
etype1 (cdr (assoc 0 elist1))
) ;_ end of setq
(while (/= etype1 &quot;SEQEND&quot
(if (= etype1 &quot;ATTRIB&quot
(progn
(setq current (cdr (assoc 1 elist1)))
(if (= current old)
(progn
(setq elist1 (subst (cons 1 new)
(assoc 1 elist1)
elist1
) ;_ end of subst
) ;_ end of setq
(entmod elist1)
) ;end progn
) ;end if current = old?
) ;end progn entity is attrib
) ;end if entity type?
(setq
ent1 (entnext ent1)
elist1 (entget ent1)
etype1 (cdr (assoc 0 elist1))
) ;_ end of setq
) ;end while not seqend
(entupd ent)
) ;end progn block has attributes
) ;end if attributes?
) ;end while not end of ss1
) ;end progn blocks exist
) ;end if blocks exist?
) ;end of repatt

;ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
;RELEASE 10 OR LATER
(defun c:nodash () ;DRIVES REPATT WITH - TO <NULL>
(repatt
(cdr
(assoc
2
(entget
(car
(entsel
&quot;\nSelect block to eliminate dash attributes: &quot;
;select block
) ;_ end of entsel
) ;_ end of car
) ;_ end of entget
) ;_ end of assoc
) ;_ end of cdr
&quot;-&quot; ;old string
&quot;&quot; ;new string
) ;_ end of repatt
) ;_ end of defun

;ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
;Release 10 or later
(defun c:repatt ( ;REPLACE ATTRIBS GLOBALLY, INTERACTIVE
/
)
(repatt
(cdr
(assoc
2
(entget
(car
(entsel
&quot;\nSelect block to replace attributes: &quot; ;select block
) ;_ end of entsel
) ;_ end of car
) ;_ end of entget
) ;_ end of assoc
) ;_ end of cdr
(progn
(setq
oldatt (if oldatt
oldatt
&quot;&quot;
) ;_ end of if
test (getstring T (strcat &quot;\nOld attribute value<&quot; oldatt &quot;>:&quot)
oldatt (if test
test
oldatt
) ;_ end of if
) ;_ end of setq
) ;_ end of progn
(progn
(setq
newatt (if newatt
newatt
&quot;&quot;
) ;_ end of if
test (getstring T (strcat &quot;\nNew attribute value<&quot; newatt &quot;>:&quot)
newatt (if test
test
newatt
) ;_ end of if
) ;_ end of setq
) ;_ end of progn
) ;end call to repatt
) ;end c:repatt
;ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
;ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
;replaces the value of text and attribute entities with a given value
;RELEASE 11 OR LATER
;Mike Weaver (907)344-7263 2/11/92
;ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
(defun attrep ( ;REPLACES VALUES OF SELECTED ATTRIBS
value ;new value for entity
/ ;end of argument list
ent ;list returned by nentsel
elist ;entity list for current entity
etype ;entity type for current entity
)
(while (setq ent (nentsel &quot;\nSelect attribute: &quot)
(setq
elist (entget (car ent))
etype (cdr (assoc 0 elist))
) ;_ end of setq
(cond
((= &quot;TEXT&quot; etype)
(princ &quot;\nEntity selected was text. &quot
(setq elist (subst (cons 1 value) (assoc 1 elist) elist))
(entmod elist)
) ;end cond TEXT
((= &quot;ATTRIB&quot; etype)
(princ &quot;\nEntity selected was an attribute. &quot
(setq elist (subst (cons 1 value) (assoc 1 elist) elist))
(entmod elist)
) ;end cond ATTRIB
(T
(princ &quot;\nEntity selected not text or an attribute. &quot
) ;end cond not valid
) ;end cond etype?
) ;end while
(if elist
(entupd (cdr (assoc -1 elist)))
) ;_ end of if
) ;end attrep

(defun c:null () ;DRIVES ATTREP WITH <NULL>
(attrep &quot;&quot
(princ)
) ;_ end of defun
;;;ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
;;;ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
;;;c:adt takes selected text and/or attribute entities and combines their
;;;values adding a space and applies the result to the first entity
;;;selected.
;;;
;;;c:adtx works similarly to c:adt except all entities after the first are
;;;erased and there is no space added between the entities.
;;;
;;;adt is the engine driven by c:adt and c:adtx. It's syntax is as follows.
;;;(adt spacemode erasemode)
;;;Where the arguments have the following meanings:
;;;spacemode if non-nil a space is added between text values.
;;;erasemode if non-nil subsequent entities are erased.
;;;

;RELEASE 11 OR LATER

(defun c:adt () ;adds text values with a space, doesn't erase anything
(adt T nil)
) ;_ end of defun

(defun c:adtx () ;adds text values without a space, erases subseqent entities
(adt nil T)
) ;_ end of defun


(defun adt ( ;COMBINES TEXT/ATTRIBUTE VALUES
spacemode ;add intermediate space if non-nil
erasemode ;erase all but 1st item if non-nil
/ ;end of formal argument list
valid ;local function
ent1 ;primary entity
ent2 ;secondary entity
elist1 ;entity list for ent1
elist2 ;entity list for ent2
test ;loop control flag
*error* ;internal error handler
undo ;undo control flag
)
;;;ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
;;LCA - COMMENT: *error* defun no longer evaluates as a list.
;;LCA - COMMENT: *error* defun no longer evaluates as a list.
(defun *error* (st)
(if undo
(progn
(setvar &quot;cmdecho&quot; 0)
(command &quot;undo&quot; &quot;e&quot
(setvar &quot;cmdecho&quot; 1)
(setq undo nil)
) ;_ end of progn
) ;_ end of if
(if ent1
(redraw (car ent1))
) ;_ end of if
(princ st)
(princ)
) ;_ end of defun
;;;ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
(defun valid (elist) ;VALIDATES ENTITY TYPES
(if (or
(= (cdr (assoc 0 elist)) &quot;TEXT&quot
(= (cdr (assoc 0 elist)) &quot;ATTRIB&quot
) ;end or
T ;return T
nil
) ;end if
) ;end valid
;;;ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
(setvar &quot;cmdecho&quot; 0)
(command &quot;undo&quot; &quot;m&quot
(setq undo T)
(setvar &quot;cmdecho&quot; 1)
(setq ent1 (nentsel &quot;\nSelect primary entity: &quot)
(if ent1
(progn
(redraw (car ent1) 3)
(setq
elist1 (entget (car ent1))
) ;_ end of setq
(if (valid elist1)
(progn
(setq test T)
(while test
(setq
ent2 (nentsel (strcat &quot;\n&quot;
(cdr (assoc 1 elist1))
&quot;\nSelect entity to combine: &quot;
) ;_ end of strcat
) ;_ end of nentsel
elist2 (if ent2
(entget (car ent2))
) ;_ end of if
) ;_ end of setq
(if (and elist2 (valid elist2))
(progn
(setq
elist1 (subst
(cons 1
(strcat
(cdr (assoc 1 elist1))
(if spacemode
&quot; &quot;
&quot;&quot;
) ;_ end of if
(cdr (assoc 1 elist2))
) ;end strcat
) ;end cons
(assoc 1 elist1)
elist1
) ;end subst
) ;end setq
(if erasemode
(progn
(entdel (car ent2))
) ;end progn
nil
) ;end if
(entmod elist1)
(redraw (car ent1) 3)
) ;end progn
(if ent2
(princ &quot;\nInvalid entity: &quot
(setq test nil)
) ;_ end of if
) ;end if elist2 is valid
) ;end while test
(redraw (car ent1)) ;redraw the new entity
) ;end progn valid elist1
(princ &quot;\nInvalid entity: &quot
) ;end if valid elist1?
) ;end progn entity selected
) ;end if entity selected?
(setvar &quot;cmdecho&quot; 0)
(command &quot;undo&quot; &quot;e&quot
(setq undo nil)
(setvar &quot;cmdecho&quot; 1)
(princ)
) ;end c:adt
;;;ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
;;;ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
;;;RELEASE 11 OR LATER
(defun c:att (
;;;STUFF TEXT VALUES INTO ATTRIBUTES
/ ;no formal arguments
ent1 ;entity name of first item
elist1 ;entity list of first item
etype1 ;entity type of first item
ent2 ;entity name of second item
elist2 ;entity list of second item
etype2 ;entity type of second item
)
(setq
ent1 (car (nentsel &quot;\nSelect attribute or text to change: &quot)
elist1 (entget ent1)
etype1 (cdr (assoc 0 elist1))
) ;_ end of setq
(if (or (= &quot;ATTRIB&quot; etype1) (= &quot;TEXT&quot; etype1))
(progn
(setq
ent2 (car (nentsel &quot;\nSelect value to use: &quot)
elist2 (entget ent2)
etype2 (cdr (assoc 0 elist2))
) ;_ end of setq
(if (or (= &quot;ATTRIB&quot; etype2) (= &quot;TEXT&quot; etype2))
(progn
(setq elist1 (subst (assoc 1 elist2) (assoc 1 elist1) elist1))
(entmod elist1)
(entupd ent1)
) ;_ end of progn
(princ &quot;\nSecond entity was not text or attribute &quot
) ;end if
) ;end if etype1 was an attrib
(princ &quot;\nEntity was not an attribute &quot
) ;end if etype1 was an attrib?
(princ)
) ;end c:att
;;;ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
;;;RELEASE 11 OR LATER
(defun c:swap ( ;SWAP TEXT OR ATTRIBUTE VALUES
/ ;no formal arguments
ent1 ;entity name of first item
elist1 ;entity list of first item
etype1 ;entity type of first item
val1 ;assoc 1 value of first item
ent2 ;entity name of second item
elist2 ;entity list of second item
etype2 ;entity type of second item
val2 ;assoc 1 value of second item
)
(setq
ent1 (car (nentsel &quot;\nSelect first attribute or text: &quot)
elist1 (entget ent1)
etype1 (cdr (assoc 0 elist1))
) ;_ end of setq
(if (or (= &quot;ATTRIB&quot; etype1) (= &quot;TEXT&quot; etype1))
(progn
(setq
ent2 (car (nentsel &quot;\nSelect second attribute or text: &quot)
elist2 (entget ent2)
etype2 (cdr (assoc 0 elist2))
) ;_ end of setq
(if (or (= &quot;ATTRIB&quot; etype2) (= &quot;TEXT&quot; etype2))
(progn
(setq
val1 (assoc 1 elist1)
val2 (assoc 1 elist2)
elist1 (subst val2 val1 elist1)
elist2 (subst val1 val2 elist2)
) ;_ end of setq
(entmod elist1)
(entupd ent1)
(entmod elist2)
(entupd ent2)
) ;_ end of progn
(princ &quot;\nSecond entity was not text or attribute &quot
) ;end if
) ;end if etype1 was an attrib
(princ &quot;\nEntity was not text or attribute &quot
) ;end if etype1 was an attrib?
(princ)
) ;end c:swap
;;;ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
(defun c:res ( ;REMOVES LEADING AND TRAILING SPACES
/ ;no formal arguments
strip-end-spaces ;function to strip spaces off ends of text
ent1 ;entity name for selected entity
elist1 ;entity list for selected entity
etype1 ;entity type for selected entity
val1 ;assoc 1 value for selected entity
val2 ;val1 after stripping blanks off ends
olderr ;old error handler
*error* ;internal error handler
) ;end of local variable list
(setq olderr *error*)
;;;ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
;;LCA - COMMENT: *error* defun no longer evaluates as a list.
;;LCA - COMMENT: *error* defun no longer evaluates as a list.
(defun *error* ( ;ERROR HANDLER FOR C:RES
)
(setq *error* olderr)
(princ st)
(princ)
) ;_ end of defun
;;;ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
;;; STRIP-END-SPACES - Remove preceeding and following spaces from <str>.
;;;
(defun strip-end-spaces ( ;STRIP SPACES OFF ENDS OF TEXT
str
/
)
(vl-string-trim &quot; &quot; str)
) ;_ end of defun

;;;ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
;;;ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
;;; START MAIN FUNCTION
;;;ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
;;;ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
(setq
ent1 (car (nentsel &quot;\nSelect attribute or text: &quot)
elist1 (entget ent1)
etype1 (cdr (assoc 0 elist1))
) ;_ end of setq
(if (or (= &quot;ATTRIB&quot; etype1) (= &quot;TEXT&quot; etype1))
(progn
(setq
val1 (assoc 1 elist1)
val2 (cons 1 (strip-end-spaces (cdr val1)))
elist1 (subst val2 val1 elist1)
) ;_ end of setq
(entmod elist1)
(if (= etype1 &quot;attrib&quot
(entupd ent1)
) ;_ end of if
) ;end progn
(princ &quot;\nEntity was not text or attribute &quot
) ;end if etype1 was an attrib?
(princ)
) ;end c:res
;::ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
(defun c:ate ( ;ATTEDIT ONE REPLACE
/ ;no formal arguments
texteval ;value of system variable to restore
) ;end of local variable list
(setq texteval (getvar &quot;texteval&quot)
(setvar &quot;texteval&quot; 1)
(while (setq ent (nentsel))
(command &quot;attedit&quot
(command &quot;Y&quot; &quot;*&quot; &quot;*&quot; &quot;*&quot
(command ent &quot;v&quot; &quot;r&quot; pause &quot;&quot
) ;end while
(setvar &quot;texteval&quot; 1)
) ;end c:ate


(defun c:atm () ;ATTEDIT ONE MOVE
(while (setq ent (nentsel))
(command &quot;attedit&quot
(command &quot;Y&quot; &quot;*&quot; &quot;*&quot; &quot;*&quot
(command ent &quot;p&quot; pause &quot;&quot
) ;end while
) ;end c:atm
;;;ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
;;;ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ

(defun mod_attrib ( ;modify an attribute setting
elist ;entity name for the attrib
newval ;new assoc list
/ ;end of formal arguments
) ;end of local variable list
(entmod (subst
newval
(assoc (car newval) elist)
elist
) ;end subst
) ;end entmod
) ;end mod_attrib


(defun c:atc ( ;modify the color of an attribute
/ ;no formal arguments
ss1 ;selection set
) ;end of local variable list
(setq ss1 (ssadd))
(while (and
(setq ent (nentsel))
(setq
elist (entget (car ent))
temp (= &quot;ATTRIB&quot; (cdr (assoc 0 elist)))
) ;_ end of setq
) ;end if
(if temp
(setq ss1 (ssadd (car ent) ss1))
) ;_ end of if
) ;end while
(if (and
(setq newval (acad_colordlg 1 T))
(< 0 (sslength ss1))
) ;_ end of and
(mod_attrib_mult
ss1
(cons 62 newval)
) ;_ end of mod_attrib_mult
) ;end valid input
(princ)
) ;end c:atc

(defun c:atw ( ;modify the width of an attribute
/ ;no formal arguments
ss1 ;selection set
) ;end of local variable list
(setq ss1 (ssadd))
(while (and
(setq ent (nentsel))
(setq
elist (entget (car ent))
temp (= &quot;ATTRIB&quot; (cdr (assoc 0 elist)))
) ;_ end of setq
) ;end if
(if temp
(setq ss1 (ssadd (car ent) ss1))
) ;_ end of if
) ;end while
(if (and
(setq newval (getreal
(strcat
&quot;\nNew width&quot;
&quot;<&quot;
(rtos (cdr (assoc 41 elist)))
&quot;>.&quot;
) ;end strcat
) ;end getstring
) ;end setq
(< 0 (sslength ss1))
) ;_ end of and
(mod_attrib_mult
ss1
(cons 41 newval)
) ;_ end of mod_attrib_mult
) ;end valid input
(princ)
) ;end c:atw

(defun c:ath ( ;modify the height of an attribute
/ ;no formal arguments
ss1 ;selection set
) ;end of local variable list
(setq ss1 (ssadd))
(while (and
(setq ent (nentsel))
(setq
elist (entget (car ent))
temp (= &quot;ATTRIB&quot; (cdr (assoc 0 elist)))
) ;_ end of setq
) ;end if
(if temp
(setq ss1 (ssadd (car ent) ss1))
) ;_ end of if
) ;end while
(if (and
(setq newval (getreal
(strcat
&quot;\nNew height&quot;
&quot;<&quot;
(rtos (cdr (assoc 41 elist)))
&quot;>.&quot;
) ;end strcat
) ;end getstring
) ;end setq
(< 0 (sslength ss1))
) ;_ end of and
(mod_attrib_mult
ss1
(cons 40 newval)
) ;_ end of mod_attrib_mult
) ;end valid input
(princ)
) ;end c:ath



(defun mod_attrib_mult ( ;modify attribute setting for a selection set of attribs
ss1 ;selection set of attributes
newval ;new assoc list
/ ;end of formal arguments
) ;end of local variable list
(setq
ssl (sslength ss1)
indx -1
) ;_ end of setq
(while (> ssl (setq indx (1+ indx)))
(setq
ent (ssname ss1 indx)
elist (entget ent)
) ;_ end of setq
(entmod (if (assoc (car newval) elist)
(subst
newval
(assoc (car newval) elist)
elist
) ;end subst
(append
elist
(list newval)
) ;_ end of append
) ;end if
) ;end entmod
) ;end while
) ;end mod_attrib

(defun c:atca ( ;ATtribute Color All
/ ;no arguments
) ;end of local variable list
(atca
(cdr
(assoc
2
(entget
(car
(entsel
&quot;\nSelect block to change attribute color: &quot;
;select block
) ;_ end of entsel
) ;_ end of car
) ;_ end of entget
) ;_ end of assoc
) ;_ end of cdr
(acad_colordlg 0 T)
) ;_ end of atca
) ;_ end of defun





(defun atca ( ;change the color of all attributes within selected blocks
block ;name of block to scan
newcolor ;new attribute color
/ ;end of formal argument list
ss1 ;selection set of blocks
indx1 ;index to ss1 for current block
ent ;entity name for current block
elist ;entity list for current block
ent1 ;entity name for current sub-entity
attflag ;attributes follow flag for current block
;elist1; entity list for current sub-entity
etype1 ;entity type for current sub-entity
current ;attribute value for current attribute
) ;end of local variable list
(setq
ss1 (ssget (list (cons 2 block)))
newc newcolor
) ;_ end of setq
(if ss1
(progn
(setq indx1 -1)
(while (< (setq indx1 (1+ indx1)) (sslength ss1))
;while blocks in selection set
(setq
ent (ssname ss1 indx1)
ent1 ent
elist (entget ent)
attflag (if (assoc 66 elist)
T
nil
) ;_ end of if
) ;_ end of setq
(if attflag
(progn ;block has attributes
(setq
ent1 (entnext ent1)
elist1 (entget ent1)
etype1 (cdr (assoc 0 elist1))
) ;_ end of setq
(while (/= etype1 &quot;SEQEND&quot
(if (= etype1 &quot;ATTRIB&quot
(progn
(setq
elist1 (if (assoc 62 elist1)
(subst (cons 62 newcolor)
(assoc 62 elist1)
elist1
) ;_ end of subst
(append elist1 (list (cons 62 newcolor)))
) ;_ end of if
) ;_ end of setq
(entmod elist1)
) ;end progn, it's an attribute
) ;end if entity type?
(setq
ent1 (entnext ent1)
elist1 (entget ent1)
etype1 (cdr (assoc 0 elist1))
) ;_ end of setq
) ;end while not seqend
(entupd ent)
) ;end progn block has attributes
) ;end if attributes?
) ;end while not end of ss1
) ;end progn blocks exist
) ;end if blocks exist?
) ;end of defun atca

(defun c:atem ( ;attribute edit multiple
/ ;no formal arguments
) ;end of local variable list
(if
(and
(setq ss1 (ssget '((0 . &quot;insert&quot (66 . 1))))
(< 0 (setq ssl (sslength ss1)))
(setq
temp (princ &quot;\nSelect attribute to edit: &quot
ent (nentsel)
) ;_ end of setq
(progn
(setq elist (entget (car ent)))
(= &quot;ATTRIB&quot; (cdr (assoc 0 elist)))
) ;_ end of progn
(setq newval (getstring T (strcat &quot;<&quot; (cdr (assoc 1 elist)) &quot;>&quot))
) ;end and valid input/selections
(progn
(setq
tag (cdr (assoc 2 elist))
indx -1
) ;_ end of setq
(while (> ssl (setq indx (1+ indx)))
(if *test*
(*break* &quot;top of the while loop&quot
) ;_ end of if
(setq
ent (ssname ss1 indx)
elist (entget ent)
test T
) ;_ end of setq
(while test
(if *test*
(*break* &quot;top of the second while loop&quot
) ;_ end of if
(setq
ent (entnext ent)
elist (entget ent)
) ;_ end of setq
(if (= tag (cdr (assoc 2 elist)))
(progn
(entmod (subst (cons 1 newval) (assoc 1 elist) elist))
(setq
test T
) ;_ end of setq
) ;end progn
(if (= &quot;SEQEND&quot; (cdr (assoc 0 elist)))
(setq test nil)
) ;end if seqend
) ;end if right attrib?
) ;end while looking for attrib
) ;end while working through ss1
(command &quot;move&quot; ss1 &quot;&quot; &quot;0,0,0&quot; &quot;&quot ;regen the selection set
) ;end progn valid input
) ;end if valid input?
(princ)
) ;end c:atem

(defun c:athm ( ;attribute height multiple
/ ;no formal arguments
) ;end of local variable list
(if (and
(setq ss1 (ssget '((0 . &quot;insert&quot (66 . 1))))
(< 0 (setq ssl (sslength ss1)))
(setq
temp (princ &quot;\nSelect attribute to modify: &quot
ent (nentsel)
) ;_ end of setq
(progn
(setq elist (entget (car ent)))
(= &quot;ATTRIB&quot; (cdr (assoc 0 elist)))
) ;_ end of progn
(setq newval (getdist (strcat &quot;New height<&quot;
(rtos (cdr (assoc 40 elist)))
&quot;>&quot;
) ;_ end of strcat
) ;_ end of getdist
) ;_ end of setq
) ;end and valid input/selections
(progn
(setq
tag (cdr (assoc 2 elist))
indx -1
) ;_ end of setq
(while (> ssl (setq indx (1+ indx)))
(if *test*
(*break* &quot;top of the while loop&quot
) ;_ end of if
(setq
ent (ssname ss1 indx)
elist (entget ent)
test T
) ;_ end of setq
(status ssl indx)
(while test
(if *test*
(*break* &quot;top of the second while loop&quot
) ;_ end of if
(setq
ent (entnext ent)
elist (entget ent)
) ;_ end of setq
(if (= tag (cdr (assoc 2 elist)))
(progn
(entmod (subst (cons 40 newval) (assoc 40 elist) elist))
(setq
test T
) ;_ end of setq
) ;end progn
(if (= &quot;SEQEND&quot; (cdr (assoc 0 elist)))
(setq test nil)
) ;end if seqend
) ;end if right attrib?
) ;end while looking for attrib
) ;end while working through ss1
(command &quot;move&quot; ss1 &quot;&quot; &quot;0,0,0&quot; &quot;&quot ;regen the selection set
) ;end progn valid input
) ;end if valid input?
(princ)
) ;end c:athm


(defun c:atsm ( ;attribute style multiple
/ ;no formal arguments
oldstyle
) ;end of local variable list
(if (and
(setq ss1 (ssget '((0 . &quot;insert&quot (66 . 1))))
(< 0 (setq ssl (sslength ss1)))
(setq
temp (princ &quot;\nSelect attribute to modify: &quot
ent (nentsel)
) ;_ end of setq
(progn
(setq elist (entget (car ent)))
(= &quot;ATTRIB&quot; (cdr (assoc 0 elist)))
) ;_ end of progn
(setq
oldstyle (assoc 7 elist)
oldstyle (if oldstyle
(cdr oldstyle)
&quot;STANDARD&quot;
) ;_ end of if
temp (getstring (strcat &quot;\nStyle<&quot; oldstyle &quot;>: &quot)
newval (if (and (/= &quot;&quot; temp) (tblsearch &quot;STYLE&quot; temp))
temp
nil
) ;_ end of if
) ;_ end of setq
;;;input and verify replacement style name

) ;end and valid input/selections
(progn
(setq
tag (cdr (assoc 2 elist))
indx -1
) ;_ end of setq
(while (> ssl (setq indx (1+ indx)))
(if *test*
(*break* &quot;top of the while loop&quot
) ;_ end of if
(setq
ent (ssname ss1 indx)
elist (entget ent)
test T
) ;_ end of setq
(status ssl indx)
(while test
(if *test*
(*break* &quot;top of the second while loop&quot
) ;_ end of if
(setq
ent (entnext ent)
elist (entget ent)
) ;_ end of setq
(if (= tag (cdr (assoc 2 elist)))
(progn
(entmod (if (assoc 7 elist)
(subst (cons 7 newval) (assoc 7 elist) elist)
(append elist (cons 7 newval))
) ;_ end of if
) ;_ end of entmod
(setq
test T
) ;_ end of setq
) ;end progn
(if (= &quot;SEQEND&quot; (cdr (assoc 0 elist)))
(setq test nil)
) ;end if seqend
) ;end if right attrib?
) ;end while looking for attrib
) ;end while working through ss1
(command &quot;move&quot; ss1 &quot;&quot; &quot;0,0,0&quot; &quot;&quot ;regen the selection set
) ;end progn valid input
) ;end if valid input?
(princ)
) ;end c:atsm


(defun status ( ;WRITE STATUS TO STATUS LINE
max
now
)
(grtext -2
(strcat
(rtos (/ now max 0.01) 2 2)
&quot;%&quot;
) ;end strcat
) ;end grtext
) ;end status


(defun c:attpresuf ( ;add prefix and suffixe to multiple attributes
/ ;no formal arguments
*test* elist ent indx pref ss1 ssl suf tag temp test)
;end of local variable list
(if (and
(setq
temp (princ &quot;\nSelect blocks: &quot
ss1 (ssget '((0 . &quot;insert&quot (66 . 1)))
) ;_ end of setq
(< 0 (setq ssl (sslength ss1)))
(setq
temp (princ &quot;\nSelect attribute to edit: &quot
ent (nentsel)
) ;_ end of setq
(progn
(setq elist (entget (car ent)))
(= &quot;ATTRIB&quot; (cdr (assoc 0 elist)))
) ;_ end of progn
(setq
pref (getstring
T
(strcat &quot;Prefix to add:<&quot; (cdr (assoc 1 elist)) &quot;>&quot
) ;_ end of getstring
) ;_ end of setq
(setq
suf
(getstring
T
(strcat &quot;Suffix to add:<&quot; pref (cdr (assoc 1 elist)) &quot;>&quot
) ;_ end of getstring
) ;_ end of setq

) ;end and valid input/selections
(progn
(setq
tag (cdr (assoc 2 elist))
indx -1
) ;_ end of setq
(while (> ssl (setq indx (1+ indx)))
(if *test*
(*break* &quot;top of the while loop&quot
) ;_ end of if
(setq
ent (ssname ss1 indx)
elist (entget ent)
test T
) ;_ end of setq
(while test
(if *test*
(*break* &quot;top of the second while loop&quot
) ;_ end of if
(setq
ent (entnext ent)
elist (entget ent)
) ;_ end of setq
(if (= tag (cdr (assoc 2 elist)))
(progn
(entmod (subst
(cons 1
(strcat pref (cdr (assoc 1 elist)) suf)
) ;_ end of cons
(assoc 1 elist)
elist
) ;_ end of subst
) ;_ end of entmod
(setq
test T
) ;_ end of setq
) ;end progn
(if (= &quot;SEQEND&quot; (cdr (assoc 0 elist)))
(setq test nil)
) ;end if seqend
) ;end if right attrib?
) ;end while looking for attrib
) ;end while working through ss1
(command &quot;move&quot; ss1 &quot;&quot; &quot;0,0,0&quot; &quot;&quot ;regen the selection set
) ;end progn valid input
) ;end if valid input?
(princ)
) ;end c:atem


;;;mattprop modifies the properties of attribute entities
;;; if the property is a point then the new value is in the
;;; object coordinate system.
;|
(defun mattprop( ;modify attribute properties
bname ;block name
tag ;attribute tag
newval ;new attribute property value
dxfcode ;dxf code for the property
/ ;end of formal argument list
) ;end of local variable list
(if (and
(setq ss1 (ssget (list (cons 0 &quot;INSERT&quot (cons 2 bname) '(66 . 1))))
(< 1 (setq ssl (sslength ss1)))
) ;end and found the correct block
(progn
(setq indx -1)
(while (> ssl (setq indx (1+ indx)))
(setq
ent (ssname ss1 indx)





|;




(progn
(princ
&quot;\Attrib.lsp (c)1998 Michael Weaver dba AlasCad\n1073 Badger Road, Fairbanks, Alaska 99705\nalascad@go.com&quot;
) ;_ end of princ
) ;_ end of progn


Atleast the part about globeally changing attribs right just change it to get the attribs justification point if everyone helps everybody the world will be a better place