Multiple Enhanced attribute editor LISP

[kocbek]

hello!

im new here, so dont be mad if i request something that has been already written.

 

so, as the title says, i need a lisp routine that changes attributes of block.

specificaly i need to change an elevation of multiple points in a block.

 

i found some lisp routines on web, but havent done what i expected.

 

this is an lisp that came most close to my demands:

 

(defun pluserr (msg)
(if msg (princ msg))
(command "_.undo" "_end")
(if ps (setvar "pickstyle" ps))
(if olderr (setq *error olderr))
(princ)
)

(defun c:smileytongue:lus (/ ps plusval ent elist numstr num tval plcs elist2)
(setq ps nil plusval nil ent nil elist nil numbstr nil num nil tval nil
plcs nil elis2 nil)
(setq olderr *error* *error* pluserr)
(command "_.undo" "_g")
(setq ps (getvar "pickstyle"))
(setvar "pickstyle" 0)
(setq plusval (getreal "\n Plus value: "))
(setq plcs (getint "\nHow many decimal places? <0>: "))
(if (null plcs) (setq plcs 0))
(setq ent (nentsel))
(while ent
(setq elist (entget (car ent)))
(setq numstr (cdr (assoc 1 elist)))
(setq num (atof numstr))
(setq tval (+ plusval num))
(setq total (rtos tval 2 plcs))
(setq elist2 (subst (cons 1 total) (cons 1 numstr) elist))
(entmod elist2)
(if (= (cdr (assoc 0 elist)) "ATTRIB")(command "regen"))
(setq ent (nentsel))
);end while
(setvar "pickstyle" ps)
(command "_.undo" "_end")
(setq *error olderr)
(princ)
)

 

well..it is good but it doesent allows to select multiple objects or entire block.

and also it changes the entire elevation of points, but i want to addict or substract an original elevation to new one. per example: if i had a point that has an elevation of 230,33 and want to "drop" this elevation for 0,5. so a new elevation would be 229,83.

so if i would change this elevation for multiple points it would substract or addict all elevations of selected points by 0,5 (or some another value, that i determine).

 

i have attached one picture of how my block of points look like

 

i would be glad if anyone can help me.

Edited December 12, 2011 by kocbek
admins

[Tharwat]

Hope that I got you well ....

 

(defun c:TesT (/ st ss i n e x)
 (vl-load-com)
 ;; Tharwat 12. Dec. 2011 ;;
 (cond ((not acdoc)
        (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
       )
 )
 (if (and (setq st (getdist "\n Enter Number to substract :"))
          (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
     )
   (progn
     (vla-StartUndoMark acdoc)
     (repeat (setq i (sslength ss))
       (setq n (entnext (ssname ss (setq i (1- i)))))
       (while
         (not
           (eq (cdr (assoc 0 (setq e (entget n))))
               "SEQEND"
           )
         )
          (if (and
                (eq (cdr (assoc 0 e)) "ATTRIB")
                (not (eq (atof (cdr (assoc 1 e))) 0.))
              )
            (entmod
              (subst (cons 1 (rtos (- (atof (cdr (assoc 1 e))) st)2 )) (assoc 1 e) e)
            )
          )
          (setq n (entnext n))
       )
     )
     (vla-EndUndoMark acdoc)
   )
   (princ)
 )
 (princ)
)

[SLW210]

Please read the CODE POSTING GUIDELINES and edit your post.

[Tharwat]

Please read the CODE POSTING GUIDELINES and edit your post.

 

Many people are new nowadays , and the majority not familiar with code posting , but certainly would come by time

[kocbek]

Thank you Tharwat for quick reply.

i tested your routine and it works, but by changing point height (elevation) it changes point number also.

i only want to change one attribute and that would be point height (elevation).

 

and another question, i tried to set rtos precision to 2 decimals (rtos x 2 2), but i dont find a place where this set number would be. i have only found the number thats sets rtos mode.

so now i get point height precision set to 4 decimals. (its a little too precise for what i need )

would u tell me where can i change rtos precision please?

[Tharwat]

You're welcome kocbek .

 

To change the precision of number in the routine , and it's the same as you shown with your example .

 

So here is the part where you can change the precision and the number you increase the precision would be increased as well .

 

(if (and                 
(eq (cdr (assoc 0 e)) "ATTRIB")                 
(not (eq (atof (cdr (assoc 1 e))) 0.)))        
     (entmod  (subst (cons 1 (rtos (- (atof (cdr (assoc 1 e))) st) 2 [color=blue][b]2[/b][/color])) ;;;<-- Change the Blue colored number to see the changes in precisions.
                     (assoc 1 e) e)))

Tharwat

[kocbek]

this lisp is still changing my point number and height instead of just point height.

if i want to decrease point height by per example 1, it decreases point height from 300,00 to 299,00 and point number from 45 to 44. i want that point number 45 would remain the same.

would you change that for me, cause im not that much expert in lisp.

thanx

[kocbek]

one more thing,

by point number i mean point name, as shown in attached picture above.

[BIGAL]

You can change block attributes in a number of ways

 

Change All just using attrib

Change 1 only using the tag name or its attribute order in the block

 

Search for edit attribs by blockname & tagname there is a number of examples here by I am sure Lee Mac ?

[pBe]

quick one:

 

(defun c:ValAddSub (/ aDoc val Tag itm  ss)
 (vl-load-com)
 (setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (setq Tag "H");<--- Your point height TAG name      
 (cond
   ((and
      (setq Val (getreal "\n Enter Value to Add/Substract [Negative value to subtract]: "))
      (ssget
        ":L"
        '((0 . "INSERT") (66 . 1))
        )
      (vlax-for
         itm (setq ss (vla-get-ActiveSelectionSet aDoc))
        (if (and
 (setq itm (assoc
                (strcase tag)
                (mapcar
                  (function
                    (lambda (j)
                      (list
                        (vla-get-tagstring j)
                        (vla-get-textstring j)
                        j
                        )
                      )
                    )
                  (vlax-invoke itm 'GetAttributes)
                  )
                )
                )
              )(progn
                  (- (distof (vla-get-textstring (last itm))) val) 
            (vla-put-textstring (last itm) (rtos  (+ (distof (vla-get-textstring (last itm))) val)  2 2)))

          )
        )
      (vla-delete ss)
      )
    )
   )
 )

 

Tharwats code:

 

(if (and
                (eq (cdr (assoc 0 e)) "ATTRIB")
                (not (eq (atof (cdr (assoc 1 e))) 0.))
               [color=blue] (eq (cdr (assoc 2 e)) "H") [/color]
              )
            (entmod
              (subst (cons 1 (rtos (- (atof (cdr (assoc 1 e))) st) 2 [color=blue]2[/color])) (assoc 1 e) e)
            )
          )

Edited December 13, 2011 by pBe

[Tharwat]

Check this one ....

 

(defun c:TesT (/ st ss i n e x)
 (vl-load-com)
 ;; Tharwat 12. Dec. 2011 ;;
 (cond ((not acdoc) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))))
 (if (and (setq st (getdist "\n Enter Number to substract :"))
          (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
     )
   (progn (vla-StartUndoMark acdoc)
          (repeat (setq i (sslength ss))
            (setq n (entnext (ssname ss (setq i (1- i)))))
            (while (not (eq (cdr (assoc 0 (setq e (entget n)))) "SEQEND"))
              (if (and (eq (cdr (assoc 0 e)) "ATTRIB")
                       (not (eq (atof (cdr (assoc 1 e))) 0.))
                       (eq (cdr (assoc 2 e)) "H")
                  )
                (entmod (subst (cons 1 (rtos (- (atof (cdr (assoc 1 e))) st) 2 2)) (assoc 1 e) e))
              )
              (setq n (entnext n))
            )
          )
          (vla-EndUndoMark acdoc)
   )
   (princ)
 )
 (princ)
)

[pBe]

... did'nt mean to step on your toes there tharwat, i also posted the same mod for you code on my post.

[Tharwat]

... did'nt mean to step on your toes there tharwat, i also posted the same mod for you code on my post.

 

No at all my friend .

 

I do like to see many ways of coding on the same issue .

 

Cheers pBe .

[kocbek]

thank you all very much for help!

im trying to understand this lisp code and can someone explain me what means this part of code: "((0 . "INSERT") (66 . 1))"?

 

ok now a new problem has ocurred. in previous lisp routine i wanted to add or substract point height (elevation), but now i need to change text height of those same points per example from 0.350 to 0.500.

can someone do this for me please?

[BIGAL]

Kocbek you need a different routine basicly a modification of the offered ones the only difference would be an extra line

 

enter exist value

enter new value

this line will change also it does not do a - (entmod (subst (cons 1 (rtos (- (atof (cdr (assoc 1 e))) st) 2 2)) (assoc 1 e) e))

 

It better for the above posters to make change in case I stuff something up

 

Ps Tharwat should the getdist be a getreal

[kocbek]

Sorry Bigal, but i dont understand what do you mean with your answer. i know that for next quest i need to modify lisp routine, but i dont know how to do this.

and still i dont understand what means ((0 . "insert")(66 . 1))? especialy what 66.1 means. i cant find this explanation in group codes list.

[BIGAL]

If you can easliy highlight the objects then just use FIND

[pBe]

thank you all very much for help!

im trying to understand this lisp code and can someone explain me what means this part of code: "((0 . "INSERT") (66 . 1))"?

 

those are filter list used in conjunction with ssget, which means only entity properties listed will be included on the selection

where

0 is object type

66 means “Entities follow” flag

 

 

Variable attributes-follow flag (optional; default = 0); if the value of attributes-follow flag is 1, a series of attribute entities is expected to follow the insert, terminated by a seqend entity

 

 

 

ok now a new problem has ocurred. in previous lisp routine i wanted to add or substract point height (elevation), but now i need to change text height of those same points per example from 0.350 to 0.500.

can someone do this for me please?

 

The code i posted gives you that option, if the supplied number is negative it Subtracts rather than Add

 

By text height you mean the attdefs text height? attredef or _eattedit will do that for you.

[Tharwat]

 

Ps Tharwat should the getdist be a getreal

 

Hi BIGAL .

 

getdist function would handle two options ( real and integer numbers ) instead of one like getreal function.

[pBe]

Hi BIGAL .

 

getdist function would handle two options ( real and integer numbers ) instead of one like getreal function.

 

Not really tharwat

 

Besides the OP specifically asks for real number hence (rtos var 2 2)