Jump to content

Multiple Enhanced attribute editor LISP


kocbek

Recommended Posts

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.

point att.jpg

Edited by kocbek
admins
Link to comment
Share on other sites

  • Replies 23
  • Created
  • Last Reply

Top Posters In This Topic

  • Tharwat

    7

  • kocbek

    6

  • pBe

    4

  • BIGAL

    3

Top Posters In This Topic

Posted Images

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

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 ?

Link to comment
Share on other sites

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 by pBe
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...