Select Block, Assign Attribute Value with Stored Variable

Friends, I need some assistance.

Here's the end game:

I want to steal an attribute value from one dynamic block (via user select), and assign it to a different attribute in another dynamic block (also via user select).

Block #1 Name: "PID-Line-ID"

Block #1 Attribute Tag: "LINE-ID"

Block #2 Name: "PIP-VALVE-MAN"

Block #2 Attribute Tag: "LINE_NO"

I've been able to get and store the value of the attribute in block #1. I need help assigning this stored variable to the attribute in block #2.

I've used lisp over the years many times, but only to address specific issues like this one. I've never taken the time to learn it well enough to write my own code without help. I'm trying to use Lee Mac's Attribute Function routines, but I don't understand how to implement them in my own routines that I can run via the command line.

Autocad 2016

Also, I don't know ANY VBA.

Thanks in advance for your help!

-Aaron

;;LISP routine to quickly populate P&ID line number info into Manual Valve Block.
;;------------------
;;This section by Lee Mac
;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [ent] Block (Insert) Entity Name
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.
(defun LM:getattributevalue ( blk tag / val enx )
   (while
       (and
           (null val)
           (setq blk (entnext blk))
           (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))
       )
       (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
           (setq val (cdr (assoc 1 (reverse enx))))
       )
   )
)
(defun LM:setattributevalue ( blk tag val / end enx )
   (while
       (and
           (null end)
           (setq blk (entnext blk))
           (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))
       )
       (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
           (if (entmod (subst (cons 1 val) (assoc 1 (reverse enx)) enx))
               (progn
                   (entupd blk)
                   (setq end val)
               )
           )
       )
   )
)
;;------------------------------------------------
;;This Section by Aaron Beck
;;Get Attribute from Block #1
(defun c:GA (/ obj1 str1)
(setq obj1 (car(entsel "Select Line Number...")))
(setq str1 (LM:getattributevalue obj1 "LINE-ID"))
)
;;Assign Attribute from Block #1 to Block #2
(defun c:SA (/ obj2 str2)
;;HELP HELP HELP

Drawing1.dwg

If you want to manually pick the attributes :

(defun c:tst ( / e1 e2)
 (vl-load-com)
 (and (setq e1 (nentsel "\nSelect text source"))
      (vlax-property-available-p (setq e1 (vlax-ename->vla-object (car e1))) 'textstring)
      (setq e2 (nentsel "\nSelect text target"))
      (vlax-property-available-p (setq e2 (vlax-ename->vla-object (car e2))) 'textstring)
      (vla-put-textstring e2 (vla-get-textstring e1))))

Here's another:

(defun c:foo (/ _foo a s)
 ;; RJP » 2018-08-02
 (defun _foo (b tag f)
   (vl-some '(lambda (x)
	(cond ((= (strcase tag) (strcase (vla-get-tagstring x)))
	       (if f
		 (not (vla-put-textstring x f))
		 (vla-get-textstring x)
	       )
	      )
	)
      )
     (vlax-invoke b 'getattributes)
   )
 )
 (cond
   ((and (setq s (ssget ":L" '((0 . "insert") (66 . 1))))
  (setq s (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))))
  (setq	a
	 (vl-some
	   '(lambda (x)
	      (cond ((= "PID-LINE-ID" (strcase (vla-get-effectivename x))) (_foo x "LINE-ID" nil))
	      )
	    )
	   s
	 )
  )
    )
    (foreach x s (_foo x "LINE_NO" a))
   )
 )
 (princ)
)

@ronjonp

nice use of the f-option

@ronjonp

 

nice use of the f-option

Cheers!

@RJP, note that the vla-*-textstring methods will return nil, so you'll loose the vl-some behaviour for _foo.

@RJP, note that the vla-*-textstring methods will return nil, so you'll loose the vl-some behaviour for _foo.

Good call

Good call

well.. theres a quick fix to this:

(cond 
 ((= (strcase tag) (strcase (vla-get-tagstring x)))
   (if f
     (vla-put-textstring x f)
     (vla-get-textstring x)
   )
   [b][color=red]t[/color][/b]
 )
)

Yup .. you beat me to it had to do some 'real' work. Updated code above ... appreciate the input.

If you want to manually pick the attributes :

This does the job, but the "target" attribute in my case is non-visible. I can select the target block, but not the specific attribute in that block.

This does the job, but the "target" attribute in my case is non-visible. I can select the target block, but not the specific attribute in that block.

Use THIS. Will match one source to many .. if needed.

Here's another:

(defun c:foo (/ _foo a s)
 ;; RJP » 2018-08-02
 (defun _foo (b tag f)
   (vl-some '(lambda (x)
	(cond ((= (strcase tag) (strcase (vla-get-tagstring x)))
	       (if f
		 (vla-put-textstring x f)
		 (vla-get-textstring x)
	       )
	       t
	      )
	)
      )
     (vlax-invoke b 'getattributes)
   )
 )
 (cond
   ((and (setq s (ssget ":L" '((0 . "insert") (66 . 1))))
  (setq s (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))))
  (setq	a
	 (vl-some
	   '(lambda (x)
	      (cond ((= "PID-LINE-ID" (strcase (vla-get-effectivename x))) (_foo x "LINE-ID" nil))
	      )
	    )
	   s
	 )
  )
    )
    (foreach x s (_foo x "LINE_NO" a))
   )
 )
 (princ)
)

When I try this option, it does populate the second attribute, but not with the correct text string. I get a result of "-1" in the attribute value every time, when it should read "4"-8A1-VG-4015". In my original post I attached a drawing with the exact blocks I want to use this on.

-Aaron

When I try this option, it does populate the second attribute, but not with the correct text string. I get a result of "-1" in the attribute value every time, when it should read "4"-8A1-VG-4015". In my original post I attached a drawing with the exact blocks I want to use this on.

 

-Aaron

haha .. the T busted it. .. gimme a second.

Try this:

(defun c:foo (/ _foo a s)
 ;; RJP » 2018-08-02
 (defun _foo (b tag f)
   (vl-some '(lambda (x)
	(cond ((= (strcase tag) (strcase (vla-get-tagstring x)))
	       (if f
		 (not (vla-put-textstring x f))
		 (vla-get-textstring x)
	       )
	      )
	)
      )
     (vlax-invoke b 'getattributes)
   )
 )
 (cond
   ((and (setq s (ssget ":L" '((0 . "insert") (66 . 1))))
  (setq s (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))))
  (setq	a
	 (vl-some
	   '(lambda (x)
	      (cond ((= "PID-LINE-ID" (strcase (vla-get-effectivename x))) (_foo x "LINE-ID" nil))
	      )
	    )
	   s
	 )
  )
    )
    (foreach x s (_foo x "LINE_NO" a))
   )
 )
 (princ)
)

Try this:

(defun c:foo (/ _foo a s)
 ;; RJP » 2018-08-02
 (defun _foo (b tag f)
   (vl-some '(lambda (x)
	(cond ((= (strcase tag) (strcase (vla-get-tagstring x)))
	       (if f
		 (not (vla-put-textstring x f))
		 (vla-get-textstring x)
	       )
	      )
	)
      )
     (vlax-invoke b 'getattributes)
   )
 )
 (cond
   ((and (setq s (ssget ":L" '((0 . "insert") (66 . 1))))
  (setq s (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))))
  (setq	a
	 (vl-some
	   '(lambda (x)
	      (cond ((= "PID-LINE-ID" (strcase (vla-get-effectivename x))) (_foo x "LINE-ID" nil))
	      )
	    )
	   s
	 )
  )
    )
    (foreach x s (_foo x "LINE_NO" a))
   )
 )
 (princ)
)

Boom, that works great. Thanks again for the help!

Boom, that works great. Thanks again for the help!

Glad to help

This does the job, but the "target" attribute in my case is non-visible. I can select the target block, but not the specific attribute in that block.

ah , missed the non-visible part ... awell , ronjonp & grrr finished the job so happy ending after all....

My $0.05 pick block 1, pick block2 all done some black magic in between, no its in the command B1-3 take the 1st block attribute 1 and copy it to the 2nd block updating attribute 3, no hard coding of tag names etc. try b3-1 b4-2 and so on all would work typed on command line at least I hope, it is based around a reactor checking for error of keyboard input it looks at errors starting with B then pulls apart the next two bits to get the attribute order rather than attribute tag name.

I use this now for circle, fillets and offsets. C23 is a circle radius = 23 F0 is obvious fillet rad=0. I have posted before pm me if you want code.

Ronjonp, I have a quick follow-up question. If I wanted to edit your lisp routine to add an additional attribute update (using the same blocks), is there a section that I can just copy and modify? Or does it require additional variables? If this was classic lisp I would be much more equipped to edit the code myself, but like I said originally, I don't know any VBA. As soon as I see "vl-blah blah blah" my brain melts.

-Aaron

Try something like this:

(defun c:foo (/ _foo a b s)
 ;; RJP » 2018-08-02
 (defun _foo (b tag f)
   (vl-some '(lambda (x)
	(cond ((= (strcase tag) (strcase (vla-get-tagstring x)))
	       (if f
		 (not (vla-put-textstring x f))
		 (vla-get-textstring x)
	       )
	      )
	)
      )
     (vlax-invoke b 'getattributes)
   )
 )
 (cond
   ((and (setq s (ssget ":L" '((0 . "insert") (66 . 1))))
  (setq s (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))))
    )
    ;; Enter your tagnames here
    (foreach tag [color="red"]'(("LINE-ID" "LINE_NO") ("TAGTOGETVALUE" "TAGTOPUTVALUE") ("SERVICE" "SERVICE"))[/color]
      (if (setq
     a (vl-some
	 '(lambda (x)
	    (cond
	      ((= "PID-LINE-ID" (strcase (vla-get-effectivename x))) (_foo x (car tag) nil))
	    )
	  )
	 s
       )
   )
 (setq b (cons (list a (cadr tag)) b))
      )
    )
    (foreach x s (foreach v b (_foo x (cadr v) (car v))))
   )
 )
 (princ)
)