Change the value of the specified TAG.

Hi, Everyone! Please help .

1.Pick Dimension (or manual input ):

2.Pick Dimension (or manual input ):

3.Pick Dimension (or manual input ) or Finish :

4.Choose the attribute blocks: (Block name =statistics)

Than ,change the "value" of TAG= "Dimensions" to value2*value2 or Value1*Value2*Value3

eg1:

1.Pick Dimension (or manual input ): 45

2.Pick Dimension (or manual input ): 30

3.Pick Dimension (or manual input ) or Finish :15

4.Choose the attribute blocks: (Block name =statistics)

5. SO, the "value" of TAG= "Dimensions" change to 45*30*15

eg2:

1.Pick Dimension (or manual input ): Φ20

2.Pick Dimension (or manual input ): 100

3.Pick Dimension (or manual input ) or Finish : （Finish）

4.Choose the attribute blocks: (Block name =statistics)

5. SO, the "value" of TAG= "Dimensions" change to Φ20*100

For attribute modifications:

http://www.lee-mac.com/attributefunctions.html

Read dimension values:

http://www.theswamp.org/index.php?topic=32263.0

HTH

Wolfgang

Thanks wkplan

For attribute modifications:

http://www.lee-mac.com/attributefunctions.html

OP no need to calculate...

Read dimension values:

http://www.theswamp.org/index.php?topic=32263.0

This is useful .but I can' t coding . Just getting started learning lisp.

Try this you enter 3 values and it asks for a position of your attributes say you have 10 if you enter 5 it will change the 5th attribute value this way its a global editor rather tahn being hard coded with a attribute tag

; Change attribute value by created position
(vl-load-com)
(setq ans1 (getstring "\nEntervalue1" ))
(setq ans2 (getstring "\nEntervalue2"))
(setq ans3 (getstring "\nEntervalue3" ))
(setq y 1)
(setq ss1 (car (entsel)))
(setq bname (vla-get-name(vlax-ename->vla-object SS1))) 

(setq x (getint "\nEnter attribute position order as a Number "))
(SETQ newstrblank (strcat ans1 "*" ans2 "*" ans3)) ; 
(foreach att (vlax-invoke (vlax-ename->vla-object SS1) 'getattributes)
   (if (= y x)
   (progn
   (setq newstr (vla-get-textstring att ))
   (vla-put-textstring att newstrblank)
   )
   )
   (setq y (+ Y 1))
)
(princ) 

Thanks BIGAL

Can't pick Dimension , and what's the "Enter line no to pick" mean ?

I just did the manual way as an example picking a dim or enter a value are two different things, If you look at any block that has a few attributes double click it, the edit dialouge will always appear in the order of attribute creation, the only difference is it will go to the attribute you have picked. The line number request I will change the words in the code above.

Try it just enter a number less than the total number of attributes you can run it on the same block just using different numbers.

Re pick dim or enter value not sure may have to a PICK if its nil ie picked nothing then enter a value, anyone out there not sure you can do both at one request ?

;this is not finished but rather a method need a bit of time to put it all together.
(defun pullapart ()
(setq val (vla-get-Measurement (vlax-ename->vla-object(car obj))))
)

(defun pickobj ()
(setq obj (entsel "\nPick a object"))
(if (= obj nil)
(setq Val (getstring "Enter Value"))
(pullapart) ; a defun that checks for a "DIM" and returns val=measurement
) 
)
;see code above goes here

Something like this ?

(defun c:Test (/ s lst b l st)
;;;	Tharwat 30.042015	;;;
 (princ "\nPick on Dimension :")
 (while (setq s (ssget "_+.:S:E" '((0 . "*DIMENSION"))))
   (setq lst (cons (ssname s 0) lst))
 )
 (if
   (and (>= (length lst) 2)
        (princ
          "\nNow select attributed Blocks that titled < statistics >"
        )
        (setq
          b (ssget "_:L" '((0 . "INSERT") (2 . "statistics") (66 . 1)))
        )
   )
    (progn
      (mapcar '(lambda (e)
                 (if (/= (setq v (cdr (assoc 1 (entget e)))) "")
                   (setq l (cons v l))
                   (setq l (cons (rtos (cdr (assoc 42 (entget e))) 2) l))
                 )
               )
              lst
      )
      (setq
        st (vl-string-right-trim
             "*"
             (apply 'strcat (mapcar '(lambda (o) (strcat o "*")) l))
           )
      )
      ((lambda (x / sn)
         (while (setq sn (ssname b (setq x (1+ x))))
           (mapcar
             '(lambda (a)
                (if (eq (strcase (vla-get-tagstring a)) "DIMENSION")
                  (vla-put-textstring a st)
                )
              )
             (vlax-invoke (vlax-ename->vla-object sn) 'getattributes)
           )
         )
       )
        -1
      )
    )
 )
 (princ)
)(vl-load-com)

Hi BIGAL , Thanks , I'm a lisp newbie , I think I need some time to understand.

Something like this ?

 

Many thanks Tharwat . It's nice .But , a little defective .

1.If I choose diameter , The end result was NO "Φ, Ø "

2.can't Enter the value.

3.when choose dimension ,not prompt.

Try this :

(defun c:Test (/ s lst b l st)
;;;    Tharwat 30.042015    ;;;
 (princ "\nSelect Dimensions :")
 (if
   (and (setq s (ssget "_:L" '((0 . "*DIMENSION"))))
        (setq st (getstring "\n Specify a value [enter to Exit] :"))
        (princ
          "\nNow select attributed Blocks that titled < statistics >"
        )
        (setq
          b (ssget "_:L" '((0 . "INSERT") (2 . "statistics") (66 . 1)))
        )
   )
    (progn
      (if (and st (/= st ""))
        (setq l (cons st l))
      )
      ((lambda (i / sn e v)
         (while (setq e (ssname s (setq i (1+ i))))
           (if (/= (setq v (cdr (assoc 1 (entget e)))) "")
             (setq l (cons v l))
             (setq l (cons (rtos (cdr (assoc 42 (entget e))) 2) l))
           )
         )
         lst
       )
        -1
      )
      (setq
        st (vl-string-right-trim
             "*"
             (apply 'strcat (mapcar '(lambda (o) (strcat o "*")) l))
           )
      )
      ((lambda (x / sn)
         (while (setq sn (ssname b (setq x (1+ x))))
           (mapcar
             '(lambda (a)
                (if (eq (strcase (vla-get-tagstring a)) "DIMENSION")
                  (vla-put-textstring a st)
                )
              )
             (vlax-invoke (vlax-ename->vla-object sn) 'getattributes)
           )
         )
       )
        -1
      )
    )
 )
 (princ)
)(vl-load-com)

Here is another possible solution:

(defun c:test ( / *error* dim fun lst rgx str tag )

   (setq tag "dimensions") ;; Tag to update

   (defun *error* ( msg )
       (if (= 'vla-object (type rgx)) (vlax-release-object rgx))
       (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   
   (defun sel ( msg prd / ent ) (setq prd (eval prd))
       (while
           (progn (setvar 'errno 0) (setq ent (car (entsel msg)))
               (cond
                   (   (= 7 (getvar 'errno))
                       (princ "\nMissed, try again.")
                   )
                   (   (null ent) nil)
                   (   (null (prd ent)))
               )
           )
       )
       ent
   )

   (setq fun '(lambda ( x ) (or (wcmatch (cdr (assoc 0 (entget x))) "*DIMENSION") (prompt "\nInvalid object selected.")))
         dim  (sel "\nSelect first dimension: " fun)
   )
   (cond
       (   (not dim))
       (   (or (null (setq rgx (vl-catch-all-apply 'vlax-get-or-create-object '("vbscript.regexp"))))
               (vl-catch-all-error-p rgx)
           )
           (princ "\nUnable to interface with RegEx Object.")
       )
       (   t
           (setq lst (cons (LM:getdimstring dim) lst))
           (while (setq dim (sel "\nSelect next dimension <done>: " fun))
               (setq lst (cons (LM:getdimstring dim) lst))
           )
           (setq str
               (apply 'strcat
                   (cdr
                       (apply 'append
                           (mapcar '(lambda ( x ) (list "*" (LM:quickunformat rgx x)))
                               (reverse lst)
                           )
                       )
                   )
               )
           )
           (sel "\nSelect block: "
              '(lambda ( e / x )
                   (cond
                       (   (not
                               (and
                                   (setq x (entget e))
                                   (= "INSERT" (cdr (assoc 0 x)))
                                   (= 1 (cdr (assoc 66 x)))
                               )
                           )
                           (prompt "\nSelected object is not an attributed block.")
                       )
                       (   (LM:setattributevalue e tag str))
                       (   (prompt (strcat "\nSelected block does not contain the tag \"" tag "\".")))
                   )
               )
           )
       )
   )
   (*error* nil)
   (princ)
)

;; Get Dimension String  -  Lee Mac
;; Returns the displayed content of a dimension

(defun LM:getdimstring ( ent / enx rtn )
   (if
       (and
           (setq enx (entget ent))
           (wcmatch (cdr (assoc 0 enx)) "*DIMENSION")
           (setq ent (tblobjname "block" (cdr (assoc 2 enx))))
           (setq ent (entnext ent)
                 enx (entget  ent)
           )
       )
       (while (and ent (null rtn))
           (if (= "MTEXT" (cdr (assoc 0 enx)))
               (setq rtn  (cdr (assoc 1 enx)))
           )
           (setq ent (entnext ent)
                 enx (entget  ent)
           )
       )
   )
   rtn
)

;; Quick Unformat  -  Lee Mac
;; Returns a string with all MText formatting codes removed.
;; rgx - [vla] Regular Expressions (RegExp) Object
;; str - [str] String to process

(defun LM:quickunformat ( rgx str )
   (if
       (null
           (vl-catch-all-error-p
               (setq str
                   (vl-catch-all-apply
                      '(lambda nil
                           (foreach pair
                              '(
                                   ("\032"     . "\\\\\\\\")
                                   (" "        . "\\\\P|\\n|\\t")
                                   ("$1"       . "\\\\(\\\\[ACcFfHKkLlOopQTW])|\\\\[ACcFfHKkLlOopQTW][^\\\\;]*;|\\\\[ACcFfKkHLlOopQTW]")
                                   ("$1$2/$3"  . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                   ("$1$2"     . "\\\\(\\\\S)|[\\\\](})|}")
                                   ("$1"       . "[\\\\]({)|{")
                                   ("\\$1$2$3" . "(\\\\[ACcFfHKkLlOoPpQSTW])|({)|(})")
                                   ("\\\\"     . "\032")
                               )
                               (vlax-put-property rgx 'pattern (cdr pair))
                               (setq str (vlax-invoke rgx 'replace str (car pair)))
                           )
                       )
                   )
               )
           )
       )
       str
   )
)

;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [ent] Block (Insert) Entity Name
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:setattributevalue ( blk tag val / enx )
   (if (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
       (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
           (if (entmod (subst (cons 1 val) (assoc 1 enx) enx))
               (progn
                   (entupd blk)
                   val
               )
           )
           (LM:setattributevalue blk tag val)
       )
   )
)

(vl-load-com) (princ)

Lee great as usual but I think you missed one thing the OP wants to be able to either pick a dim or enter a manual value, your code asks to pick a dim and gives message that its not a dim rather than the concept I was leaning towards of pick DIM or say press Enter for a value. I didnt ask the question earlier post clearly as to how you could do pick dim or value without extra steps, I dont think it can be done

DIM value DIM = 123.45*FRED*456.78

Try this :

 

Thank you ,Mr.Tharwat.

Maybe my explanation is not clear .

The following Lee' code is correct . But still a flaw.

Can't manually input values. Only Get by "Dimension" .

Here is another possible solution:

Thanks you , Lee , It's very nice.

Is it possible to do like this ?

Select first dimension:

Select next dimension :

Select next dimension ：

Unfortunately real work go in the way and this code has a problem will try to find time soon to fix but method is there.

(vl-load-com)
(defun pullapart ()
(setq val (rtos (vla-get-Measurement (vlax-ename->vla-object(car obj)))2 2))
)
(defun pickobj ()
(setq obj (entsel "\nPick a dim - Enter for value - Double Enter to exit"))
(if (= obj nil)
(setq Val (getstring "\nEnter Value"))
(pullapart) ; a defun that checks for a "DIM" and returns val=measurement
) ; if 
) ; defun

(setq y 1)
(setq ss1 (car (entsel "\nSelect block")))
(setq bname (vla-get-name(vlax-ename->vla-object SS1))) 

(setq x (getint "\nEnter attribute position within block as a Number "))
(pickobj) ; need at least one value
(setq newstrblank val) ; dummy value
(while (=/ val nil)
(SETQ newstrblank (strcat newstrblank "*" val)) ; 
(pickobj)
)
(foreach att (vlax-invoke (vlax-ename->vla-object SS1) 'getattributes)
   (if (= y x)
   (progn
   (setq newstr (vla-get-textstring att ))
   (vla-put-textstring att newstrblank)
   )
   )
   (setq y (+ Y 1))
)
(princ)

BIGAL said:

Lee great as usual but I think you missed one thing the OP wants to be able to either pick a dim or enter a manual value, your code asks to pick a dim and gives message that its not a dim rather than the concept I was leaning towards of pick DIM or say press Enter for a value. I didnt ask the question earlier post clearly as to how you could do pick dim or value without extra steps, I dont think it can be done.

cadfan said:

The following Lee' code is correct . But still a flaw.

 

Can't manually input values. Only Get by "Dimension" .

cadfan said:

Thanks you , Lee , It's very nice.

 

Is it possible to do like this ?

 

Select first dimension:

Select next dimension :

Select next dimension ：

Thanks all

Here is a possible solution to allow object selection & arbitrary input at the same prompt:

(defun c:test ( / *error* dim lst rgx str tag )

   (setq tag "dimensions") ;; Tag to update

   (defun *error* ( msg )
       (if (= 'vla-object (type rgx)) (vlax-release-object rgx))
       (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   
   (defun sel ( msg prd / ent ) (setq prd (eval prd))
       (while
           (progn (setvar 'errno 0) (setq ent (car (entsel msg)))
               (cond
                   (   (= 7 (getvar 'errno))
                       (princ "\nMissed, try again.")
                   )
                   (   (null ent) nil)
                   (   (null (prd ent)))
               )
           )
       )
       ent
   )

   (cond
       (   (= "" (setq dim (LM:select-or-text "\nSelect first dimension or enter value: " '((0 . "*DIMENSION"))))))
       (   (or (null (setq rgx (vl-catch-all-apply 'vlax-get-or-create-object '("vbscript.regexp"))))
               (vl-catch-all-error-p rgx)
           )
           (princ "\nUnable to interface with RegEx Object.")
       )
       (   t
           (setq lst (cons (if (= 'str (type dim)) dim (LM:getdimstring dim)) lst))
           (while (/= "" (setq dim (LM:select-or-text "\nSelect next dimension or enter value <done>: " '((0 . "*DIMENSION")))))
               (setq lst (cons (if (= 'str (type dim)) dim (LM:getdimstring dim)) lst))
           )
           (setq str
               (apply 'strcat
                   (cdr
                       (apply 'append
                           (mapcar '(lambda ( x ) (list "*" (LM:quickunformat rgx x)))
                               (reverse lst)
                           )
                       )
                   )
               )
           )
           (sel "\nSelect block: "
              '(lambda ( e / x )
                   (cond
                       (   (not
                               (and
                                   (setq x (entget e))
                                   (= "INSERT" (cdr (assoc 0 x)))
                                   (= 1 (cdr (assoc 66 x)))
                               )
                           )
                           (prompt "\nSelected object is not an attributed block.")
                       )
                       (   (LM:setattributevalue e tag str))
                       (   (prompt (strcat "\nSelected block does not contain the tag \"" tag "\".")))
                   )
               )
           )
       )
   )
   (*error* nil)
   (princ)
)

;; Get Dimension String  -  Lee Mac
;; Returns the displayed content of a dimension

(defun LM:getdimstring ( ent / enx rtn )
   (if
       (and
           (setq enx (entget ent))
           (wcmatch (cdr (assoc 0 enx)) "*DIMENSION")
           (setq ent (tblobjname "block" (cdr (assoc 2 enx))))
           (setq ent (entnext ent)
                 enx (entget  ent)
           )
       )
       (while (and ent (null rtn))
           (if (= "MTEXT" (cdr (assoc 0 enx)))
               (setq rtn  (cdr (assoc 1 enx)))
           )
           (setq ent (entnext ent)
                 enx (entget  ent)
           )
       )
   )
   rtn
)

;; Quick Unformat  -  Lee Mac
;; Returns a string with all MText formatting codes removed.
;; rgx - [vla] Regular Expressions (RegExp) Object
;; str - [str] String to process

(defun LM:quickunformat ( rgx str )
   (if
       (null
           (vl-catch-all-error-p
               (setq str
                   (vl-catch-all-apply
                      '(lambda nil
                           (foreach pair
                              '(
                                   ("\032"     . "\\\\\\\\")
                                   (" "        . "\\\\P|\\n|\\t")
                                   ("$1"       . "\\\\(\\\\[ACcFfHKkLlOopQTW])|\\\\[ACcFfHKkLlOopQTW][^\\\\;]*;|\\\\[ACcFfKkHLlOopQTW]")
                                   ("$1$2/$3"  . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                   ("$1$2"     . "\\\\(\\\\S)|[\\\\](})|}")
                                   ("$1"       . "[\\\\]({)|{")
                                   ("\\$1$2$3" . "(\\\\[ACcFfHKkLlOoPpQSTW])|({)|(})")
                                   ("\\\\"     . "\032")
                               )
                               (vlax-put-property rgx 'pattern (cdr pair))
                               (setq str (vlax-invoke rgx 'replace str (car pair)))
                           )
                       )
                   )
               )
           )
       )
       str
   )
)

;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [ent] Block (Insert) Entity Name
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:setattributevalue ( blk tag val / enx )
   (if (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
       (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
           (if (entmod (subst (cons 1 val) (assoc 1 enx) enx))
               (progn
                   (entupd blk)
                   val
               )
           )
           (LM:setattributevalue blk tag val)
       )
   )
)

;; Selection or Text  -  Lee Mac
;; Prompts the user to select an object or enter an arbitrary string.
;; msg - [str] [Optional] Prompt string
;; ftr - [lst] [Optional] ssget filter list
;; Returns: [ent/str] Entity name of selected entity or entered string; "" if enter is pressed.

(defun LM:select-or-text ( msg ftr / gr1 gr2 rtn sel )
   (setq msg (princ (cond (msg) ("\nSelect object: ")))
         rtn ""
   )
   (while
       (progn
           (setq gr1 (grread nil 14 2)
                 gr2 (cadr gr1)
                 gr1 (car  gr1)
           )
           (cond
               (   (= 3 gr1)
                   (if (ssget gr2) ;; nentselp is slow for xrefs
                       (if (setq sel (ssget gr2 ftr))
                           (progn (setq rtn (ssname sel 0)) nil)
                           (princ (strcat "\nInvalid object selected." msg))
                       )
                       (princ (strcat "\nMissed, try again." msg))
                   )
               )
               (   (= 2 gr1)
                   (cond
                       (   (< 31 gr2 127)
                           (setq rtn (strcat rtn (princ (chr gr2))))
                       )
                       (   (= 13 gr2)
                           nil
                       )
                       (   (and (= 8 gr2) (< 0 (strlen rtn)))
                           (setq rtn (substr rtn 1 (1- (strlen rtn))))
                           (princ "\010 \010")
                       )
                       (   t   )
                   )
               )
               (   (= 25 gr1)
                   nil
               )
               (   t   )
           )
       )
   )
   rtn
)

(vl-load-com) (princ)

Thanks all

 

Here is a possible solution to allow object selection & arbitrary input at the same prompt:

Incredible. Lee , It's very very very good. Thank you very much .

Incredible. Lee , It's very very very good. Thank you very much .

You're welcome cadfan - it was an interesting challenge to write.

I now realise that I had left the attribute tag as 'tag1' which is what I was using for testing - I have now amended this in the above code.

Lee

Lee good codes as usual, the reason I expressed the use of the attribute creation order as it it then makes the function work with any attributed block, you do not need a hard coded attribute name. So for a different block same problem you have to copy all the code if it has a different tagname. The small 1st post by me I tested on a block with 12 attributes and changed multiple attributes by repeating the code. As you well know and others reading this probably 99% of attribute requests are hard coded to a Tag name but could be more global.