Update Rev block by shifting values

[jszagorski]

We have a 3 level rev block, if the block is full I need to shift the values down 1 and clear out the top rev for the new rev details. I tried using Lee Mac's Get and Set attributes, but they are failing on me - it either doesn't like the block I'm sending it or the string. I'm trying to get specific attributes and assign them to different tags.

(defun c:UPREV (/ ent tag newList rev1 rev1Att)
  (setq *error* xx:Error)

;;;  Select title block to update

  (setq ent (car (entsel "\nSelect Attributed Block: ")))
  (setq newList (LM:vl-getattributevalues (vlax-ename->vla-object ent)))

  (setq rev1Att "REV_NO.1")
  (setq rev1 (LM:vl-getattributevalue ((vlax-ename->vla-object ent) rev1Att)))
;;;  (setq rev2 (LM:vl-getattributevalue (blk "REV_NO.2")))
;;;  (setq desc1 (LM:vl-getattributevalue (blk "DESCRIPTION_1")))
;;;  (setq desc2 (LM:vl-getattributevalue (blk "DESCRIPTION_2")))
;;;  (setq eco1 (LM:vl-getattributevalue (blk "ECO_1")))
;;;  (setq eco2 (LM:vl-getattributevalue (blk "ECO_2")))
;;;  (setq draw1 (LM:vl-getattributevalue (blk "DRAWN_BY_1")))
;;;  (setq draw2 (LM:vl-getattributevalue (blk "DRAWN_BY_2")))
;;;  (setq date1 (LM:vl-getattributevalue (blk "DATE_1")))
;;;  (setq date2 (LM:vl-getattributevalue (blk "DATE_2")))
;;;
;;;  (LM:vl-setattributevalue (blk "REV_NO.1" nil))
;;;  (LM:vl-setattributevalue (blk "REV_NO.2" rev1))
;;;  (LM:vl-setattributevalue (blk "REV_NO.3" rev2))
;;;  (LM:vl-setattributevalue (blk "DESCRIPTION_1" nil))
;;;  (LM:vl-setattributevalue (blk "DESCRIPTION_2" desc1))
;;;  (LM:vl-setattributevalue (blk "DESCRIPTION_3" desc2))
;;;  (LM:vl-setattributevalue (blk "ECO_1" nil))
;;;  (LM:vl-setattributevalue (blk "ECO_2" eco1))
;;;  (LM:vl-setattributevalue (blk "ECO_3" eco2))
;;;  (LM:vl-setattributevalue (blk "DRAWN_BY_1" nil))
;;;  (LM:vl-setattributevalue (blk "DRAWN_BY_2" draw1))
;;;  (LM:vl-setattributevalue (blk "DRAWN_BY_3" draw2))
;;;  (LM:vl-setattributevalue (blk "DATE_1" nil))
;;;  (LM:vl-setattributevalue (blk "DATE_2" date1))
;;;  (LM:vl-setattributevalue (blk "DATE_3" date2))


)

;; 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))		; all uppercase
  (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)
  )
)

;; Get Attribute Values  -  Lee Mac
;; Returns an association list of attributes present in the supplied block.
;; blk - [vla] VLA Block Reference Object
;; Returns: [lst] Association list of ((<tag> . <value>) ... )

(defun LM:vl-getattributevalues	(blk)
  (mapcar '(lambda (att)
	     (cons (vla-get-tagstring att) (vla-get-textstring att))
	   )
	  (vlax-invoke blk 'getattributes)
  )
)

(defun xx:Error	(st)
  (if (not
	(member st (list "Function cancelled" "quit / exit abort"))
      )
    (vl-bt)
  )
  (princ)
)

[Kent1Cooper · Accepted solution]

It sounds like you could just shift values regardless of whether it's "full."  Attributes have recently become "properties" of Block insertions under the (getpropertyvalue)/(setpropertyvalue) system, with the Tag being the property name and the content the value.  An Attribute with nothing in it is not nil, but an empty text string "", which you can copy to another just as you can any other string content.  So how about, given 'ent' holding the entity name of the Block [as you have it already], and with REV_NO.1 being the Tag of the top one [newest], ...2 the middle, and ...3 the bottom, simply this:

EDIT:  put into command-definition wrapping:

(defun c:UPREV (/ ent)

  (setq ent (car (entsel "\nSelect Attributed Block: ")))

  (setpropertyvalue ent "REV_NO.3" (getpropertyvalue ent "REV_NO.2")); transfer middle one down to bottom

  (setpropertyvalue ent "REV_NO.2" (getpropertyvalue ent "REV_NO.1")); transfer top one down to middle

  (setpropertyvalue ent "REV_NO.1" "YourNewestInformation"); put new value into top one

  (prin1)

)

[komondormrex]

maybe that helps

;***************************************************************************************************************************************

(defun substring (string char)
	(substr string 1 (vl-string-position (ascii char) string)) 
)

;***************************************************************************************************************************************

(defun last_char (string)
	(substr string (strlen string))
)

;***************************************************************************************************************************************

(defun c:push_down_attibutes_revision (/ attributes_revision_prefix_list block_sset block_list attributes_assoc_list attribute_list 
										 new_listed_attribute new_value
									  )
	(setq attributes_revision_prefix_list '(rev description eco drawn date))
	(while (if (setq block_sset (vl-catch-all-apply 'ssget (list '((0 . "insert")))))
			(progn
		   		(setq block_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex block_sset)))))
				(foreach block block_list 
		   			(if (minusp (vlax-get block 'hasattributes))
							(progn
								(setq attributes_assoc_list (mapcar '(lambda (attribute) (cons attribute 
																   							  (list (cons 3 "") 
																	 								(cons 2 "") 
																	 								(cons 1 "")
															   								  )
														 								 )
												 					  ) 
													 				  attributes_revision_prefix_list
											 				)
								)
								(foreach attribute (setq attribute_list (vlax-invoke block 'getattributes))
									(if (member (read (substring (vla-get-tagstring attribute) "_")) attributes_revision_prefix_list)
										(setq attributes_assoc_list 
												(subst (subst (cons (atoi (last_char (vla-get-tagstring attribute)))
																		  (vla-get-textstring attribute)
															  )
															  (assoc (atoi (last_char (vla-get-tagstring attribute)))
															  		 (cdr (assoc (read (substring (vla-get-tagstring attribute) "_")) 
																	 			 attributes_assoc_list
																		  )
																	 )
															  )
															  (assoc (read (substring (vla-get-tagstring attribute) "_")) 
															  		 attributes_assoc_list
															  )
														)
														(assoc (read (substring (vla-get-tagstring attribute) "_")) attributes_assoc_list)
														attributes_assoc_list
												)
										)
									)
								)
							  	(foreach listed_attribute attributes_assoc_list
									(if (and (/= (cdr (assoc 3 (cdr listed_attribute))) "")
										     (/= (cdr (assoc 2 (cdr listed_attribute))) "")
										     (/= (cdr (assoc 1 (cdr listed_attribute))) "")
									    )
									  	(setq new_listed_attribute
											       (subst (cons 1 (cdr (assoc 2 (cdr listed_attribute))))
												          (assoc 1 (cdr listed_attribute))
												          listed_attribute
											       )
									  	      new_listed_attribute
											       (subst (cons 2 (cdr (assoc 3 (cdr new_listed_attribute))))
												          (assoc 2 (cdr new_listed_attribute))
												          new_listed_attribute
											       )
									  	      new_listed_attribute
											       (subst (cons 3 "")
												          (assoc 3 (cdr new_listed_attribute))
												          new_listed_attribute
											       )
										      attributes_assoc_list
											       (subst new_listed_attribute
												          listed_attribute
												          attributes_assoc_list
											       )
									     )
								  	)
								)
							  	(foreach attribute attribute_list
									(if (/= (vla-get-textstring attribute)
											(setq new_value (cdr (assoc (atoi (last_char (vla-get-tagstring attribute)))
												    		            (cdr (assoc (read (substring (vla-get-tagstring attribute) "_")) 
																					attributes_assoc_list
																			 )
																		)
											     		         )
													        )     
									    	)
									    )
									  	(vla-put-textstring attribute new_value)
									)  
								)  
							)
					)
				)
				nil
			)
		 )
	)
	(princ)
)

;***************************************************************************************************************************************

[jszagorski]

That's exactly what I was trying to do, I thought, "this is got to be easy" and it is! Searching for how, not so much...

[Sea-Haven]

Just another way is to make a list of the block attributes, you can check is there 3 already filled in by looking at a attribute value is say "" REVNo3. If full and want a new one skip the 1st list of attributes then fill in the attribute values start at 2nd values in list, finally add the 3rd one. You can use the order of the attribute rather than the Tag name to get the value of an attribute same with the put new value.

Its very simple if you have a single rev block and not a title block with revs in it so lots of attributes. This shows all attributes in a block.

(defun c:wow ( / obj atts att)
(setq obj (vlax-ename->vla-object (car  (entsel "Pick block "))))
(setq atts (vlax-invoke obj 'Getattributes))
(setq lst '())
(foreach att atts
(setq lst (cons (vla-get-textstring att) lst))
)
(princ lst)
(princ)
)
(c:wow)

Post a dwg with the block.