Attribute value depending on the existing attribite value

djurk_haas · ‎07-28-2020

Hello,

Is it possible for all blocks in the drawing to change the attributevalue "RUIMTESOORT" depending on the existing attributevalue "KOSTENPLAATS"?
I think it must be something like this:

(defun c:test ()
(setq kostenplaats (??????);must be attributevalue with the tag "KOSTENPLAATS"

(cond ((= kostenplaats "1000") ((???)));Set attributevalue in block "FM_RM3" with tag "RUIMTESOORT" to "test1"
((= kostenplaats "1200") ((???)));Set attributevalue in block "FM_RM3" with tag "RUIMTESOORT" to "test2"
((= kostenplaats "1300") ((???)));Set attributevalue in block "FM_RM3" with tag "RUIMTESOORT" to "test3"

(t (princ))
)


(princ)

)

john.uhden · ‎07-28-2020

Yes.

John F. Uhden

hak_vz · ‎07-28-2020

Please provide a sample drawing with block definitions.

Here you have some code that has to be edited to solve your particular case. Have no time to play with defining blocks.

(setq ss (ssget "x" '((0 . "INSERT"))) i 0)
(REPEAT (SSLENGTH SS)
(setq bo (vlax-ename->vla-object (ssname ss i)))
(setq kostenplaats (vl-getattributevalue bo "KOSTENPLAATS"))
(cond 
	((= kostenplaats "1100")) (lm:vl-setattributevalue .......)
	((= kostenplaats "1200")) (lm:vl-setattributevalue .......)
	((= kostenplaats "1300")) (lm:vl-setattributevalue .......)
)
(setq i (+ i 1))
)



;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.

(defun LM:vl-getattributevalue ( blk tag )
    (setq tag (strcase tag))
    (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)
;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:vl-setattributevalue ( blk tag val )
    (setq tag (strcase tag))
    (vl-some
       '(lambda ( att )
            (if (= tag (strcase (vla-get-tagstring att)))
                (progn (vla-put-textstring att val) val)
            )
        )
        (vlax-invoke blk 'getattributes)
    )
)

Miljenko Hatlak

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

djurk_haas · ‎07-30-2020

I can't get it work:

;; Set Attribute Value - Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:vl-setattributevalue ( blk tag val )
(setq tag (strcase tag))
(vl-some
'(lambda ( att )
(if (= tag (strcase (vla-get-tagstring att)))
(progn (vla-put-textstring att val) val)
)
)
(vlax-invoke blk 'getattributes)
)
)

;;----------------=={ Get Attribute Value }==-----------------;;
;; ;;
;; Returns the attribute value associated with the specified ;;
;; tag, within the supplied block, if present. ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; block - VLA Block Reference Object ;;
;; tag - Attribute TagString ;;
;;------------------------------------------------------------;;
;; Returns: Attribute TextString, else nil ;;
;;------------------------------------------------------------;;

(defun LM:GetAttributeValue ( block tag )
;; © Lee Mac 2010
(vl-some
(function
(lambda ( attrib )
(if (eq tag (vla-get-Tagstring attrib))
(vla-get-TextString attrib)
)
)
)
(vlax-invoke block 'GetAttributes)
)
)

(defun c:Test (/ ent tagname)

(setq ss (ssget '((0 . "INSERT")(66 . 1))))
(repeat (setq i (sslength ss))
(setq blk (ssname ss (setq i (1- i))))

(setq kostenplaats
(LM:GetAttributeValue
(vlax-ename->vla-object ent) (strcase "KOSTENPLAATS")
)
)
)

(setq tagname "RUIMTESOORT")
(cond
( (= "1100" kostenplaats) (LM:vl-SetAttributeValue (vlax-ename->vla-object blk) tagname "Afdeling 1100") )
( (= "1200" kostenplaats) (LM:vl-SetAttributeValue (vlax-ename->vla-object blk) tagname "Afdeling 1200") )
( (= "1300" kostenplaats) (LM:vl-SetAttributeValue (vlax-ename->vla-object blk) tagname "Afdeling 1300") )
)

(princ)
)

john.uhden · ‎07-30-2020

Here's a stab at it.

No testing because I wasn't going to create a bunch of KOSTENPLATTS and RUIMTESOORTs (whatever they are).

Yes, you keen experts will notice that there is excess code in the @getatts function. That's just because I snagged it from an earlier contribution of mine and was too lazy to trim out the fat.

I hope I got the purpose correct.

(defun c:KOSTENPLAATS ( / *error* cmdecho @getatts ss blref i atts k_att r_att n)
  ;; By John Uhden (07-30-2020) dedicated to @djurk_haas
  (gc)
  (vl-load-com)
  (or *acad* (setq *acad* (vlax-get-acad-object))) ;; global
  (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*))) ;; global
  (defun *error* (error)
    (setvar "cmdecho" cmdecho)
    (vla-endundomark *doc*)
    (cond
      ((not error))
      ((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
      (1 (princ (strcat "\nERROR: " error))
        (if ok (progn (princ "\n  OK = ") (princ ok)))
      )
    )
    (princ)
  )
  (vla-endundomark *doc*)
  (vla-startundomark *doc*)
  (setq cmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "_.expert" (getvar "expert")) ;; dummy command
 
  (defun @getatts (obj  / atts Items)
     (and
        (or
          (= (vlax-get obj 'ObjectName) "AcDbBlockReference")
          (alert "Selected entity is not a block insertion.")
        )
        (or
          (equal (vla-get-hasattributes obj) :vlax-true)
          (prompt "\nBlock selected has no attributes.")
        )
        (setq atts (vla-getattributes obj))
        (setq atts (vlax-variant-value atts))
        (foreach att (vlax-safearray->list atts)
           (setq Tag (vlax-get att 'TagString)
                      Str (vlax-get att 'TextString)
                      Items (cons (list Tag Str Att) Items)
           )
        )
     )
     (reverse Items)
  )
  (setq ss (ssget "x" '((0 . "INSERT")(2 . "FN_RM3")(66 . 1))))
  (setq n 0)
  (repeat (setq i (sslength ss))
    (setq blref (ssname ss (setq i (1- i))))
    (setq atts (@getatts (vlax-ename->vla-object blref)))
    (and
        (setq k_att (assoc "KOSTENPLAATS" atts))
        (setq r_att (assoc "RUIMTESOORT" atts))
        (cond
           ((= (cadr k_att) "1000")
             (vlax-put (last r_att) "Textstring" "test1")
             (setq n (1+ n))
           )
           ((= (cadr k_att) "1200")
             (vlax-put (last r_att) "Textstring" "test2")
             (setq n (1+ n))
           )
           ((= (cadr k_att) "1300")
             (vlax-put (last r_att) "Textstring" "test3")
             (setq n (1+ n))
           )
        )
     )
  )
  (princ (strcat "\nProcessed " (itoa n) " RUIMTESOORT attributes."))
  (*error* nil)
)
(defun c:KP ()(c:KOSTENPLAATS))

John F. Uhden

ronjonp · ‎07-30-2020

Quick one untested:

(defun c:foo (/ a s)
  ;; RJP » 2020-07-30
  (if (setq s (ssget ":L" '((0 . "insert") (66 . 1) (2 . "FM_RM3"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (and (setq a (getpropertyvalue e "SIZE"))
	   (setq a (cond ((= a "1000") "Test1")
			 ((= a "1200") "Test2")
			 ((= a "1300") "Test3")
		   )
	   )
	   (setpropertyvalue e "ID" a)
      )
    )
  )
  (princ)
)

djurk_haas · ‎08-02-2020

Thanks ronjonp and john,

but unfortunately both solutions give error messages and don't work?

ronjonp · ‎08-03-2020

@djurk_haas Try this ... my code above had incorrect tagnames for your block 'FM_RM3'.

(defun c:foo (/ a s)
  ;; RJP » 2020-07-30
  (if (setq s (ssget ":L" '((0 . "insert") (66 . 1) (2 . "FM_RM3"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (and (setq a (getpropertyvalue e "KOSTENPLAATS"))
	   (setq a (cond ((= a "1000") "Test1")
			 ((= a "1200") "Test2")
			 ((= a "1300") "Test3")
		   )
	   )
	   (setpropertyvalue e "RUIMTESOORT" a)
      )
    )
  )
  (princ)
)

john.uhden · ‎08-03-2020

I had some misspelling and a typo (because I hadn't tested).

Try this one:

(defun c:KOSTENPLAATS ( / *error* cmdecho @getatts ss blref i atts k_att r_att n)
  ;; By John Uhden (08-03-2020) dedicated to @djurk_haas
  (gc)
  (vl-load-com)
  (or *acad* (setq *acad* (vlax-get-acad-object))) ;; global
  (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*))) ;; global
  (defun *error* (error)
    (setvar "cmdecho" cmdecho)
    (vla-endundomark *doc*)
    (cond
      ((not error))
      ((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
      (1 (princ (strcat "\nERROR: " error))
        (if ok (progn (princ "\n  OK = ") (princ ok)))
      )
    )
    (princ)
  )
  (vla-endundomark *doc*)
  (vla-startundomark *doc*)
  (setq cmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "_.expert" (getvar "expert")) ;; dummy command
 
  (defun @getatts (obj  / atts Items)
     (and
        (or
          (= (vlax-get obj 'ObjectName) "AcDbBlockReference")
          (alert "Selected entity is not a block insertion.")
        )
        (or
          (equal (vla-get-hasattributes obj) :vlax-true)
          (prompt "\nBlock selected has no attributes.")
        )
        (setq atts (vla-getattributes obj))
        (setq atts (vlax-variant-value atts))
        (foreach att (vlax-safearray->list atts)
           (setq Tag (vlax-get att 'TagString)
                      Str (vlax-get att 'TextString)
                      Items (cons (list Tag Str Att) Items)
           )
        )
     )
     (reverse Items)
  )
  (setq ss (ssget "x" '((0 . "INSERT")(2 . "FN_RM3")(66 . 1))))
  (setq n 0)
  (repeat (setq i (sslength ss))
    (setq blref (ssname ss (setq i (1- i))))
    (setq atts (@getatts (vlax-ename->vla-object blref)))
    (and
        (setq k_att (assoc "KOSTENPLAATS" atts))
        (setq r_att (assoc "RUIMTESOORT" atts))
        (cond
           ((= (cadr k_att) "1000")
             (vlax-put (last r_att) "Textstring" "test1")
             (setq n (1+ n))
           )
           ((= (cadr k_att) "1200")
             (vlax-put (last r_att) "Textstring" "test2")
             (setq n (1+ n))
           )
           ((= (cadr k_att) "1300")
             (vlax-put (last r_att) "Textstring" "test3")
             (setq n (1+ n))
           )
        )
     )
  )
  (princ (strcat "\nProcessed " (itoa n) " RUIMTESOORT attributes."))
  (*error* nil)
)
(defun c:KP ()(c:KOSTENPLAATS))

John F. Uhden

Community

Attribute value depending on the existing attribite value

Attribute value depending on the existing attribite value

Attribute value depending on the existing attribite value