lisp to move attribute values to next value

[MajorWedgee]

Hi all, I was wondering if anybody had a lisp to move the attribute value to the next value in that block?

Our client has their own bill of material and rebar schedule blocks with attributes, see attached screenshot. The client pulls this data from the .dwg to be used in their scheduling & ordering system, so we're not at liberty to change the block or attribute names. Really, we don't even fill in the ID, or C tags for any of the items, those are just there so the fields get created in their database when the .dwgs are processed.

What I'm looking for is an easy way to increment the values in the attributes to the next one. For quite some time we've just gone in and cut/ paste the text in the properties bar when we've needed to add another item to the bom. This can be tedious when we need to cut paste multiple attributes to make for 1 blank line.

I've attached a screenshot of a completed bom. Let's say I needed to add a 0L28P02 item to this bom, I'd need to move the P04 through P19 items down 1 line, that's 12 attribute values to cut/paste.

In looking around I found a nice piece of code from Lee Mac which somewhat accomplishes what I'm after, but his moves all of the attributes, what I'd like is something that would only move the attributes only the attributes above or below up or down from the selection point. Is there a way to modify this code to work as I want? I've played with lisp some, far from being an expert, more of a hack, and can usually figure out how it's working, but on this one i have no clue.

PS, I'm sure you're all well aware of Lee Mac, but if you're not, check out his website, http://lee-mac.com/index.html
Personally I've used quite a bit of his code, and learned quite a bit just by looking through it.

(defun c:bump ( / a g ) ;; Lee Mac 2011
  (cond
    ( (setq a (ssget "_+.:S:E:L" '((0 . "INSERT") (66 . 1))))
      (setq a (vlax-invoke (vlax-ename->vla-object (ssname a 0)) 'getattributes))
      (princ "\nPress [+/-] to Bump Attributes Up & Down. <Done>")
      (while (member (setq g (grread nil 10)) '((2 45) (2 95) (2 43) (2 61)))
        (mapcar 'vla-put-textstring a
          (mapcar 'vla-get-textstring
            (if (member g '((2 45) (2 95))) (cons (last a) a) (append (cdr a) (list (car a))))
          )
        )
      )
    )
  )
  (princ)
)
(vl-load-com) (princ)

[MajorWedgee]

In thinking about it more, I don't know if it's possible. By clicking the block, you're selecting the block, not a position within the block. Hopefully the client updates their system at some point in the future.

[Opie]

It's possible. The entsel function provides an entity name of the element picked and the picked point. Using the nentselp function you can then determine which row the user picked, if they picked one of the attributes. It will just be more code than you provided earlier.

[Opie]

Using some code found here on AUGI and Autodesk's forums, we have this ... thing. It will overwrite the last row of attributes items. It will move a row of attributes down to the next line. If that line is not empty, it will move the rows below until an empty row is found. It will then empty the selected row.

(defun c:bumpRow (/	      oBlock	  oAttributes bEmptyRow
		  eBlock      i		  iEmptyRow   lstAttribs
		  lstRows     oRow	  sRow	      iRow
		  GetBlkAttrib		  PutBlkAttrib
		 )
					;-------------------------------------------------------------------------------
					; GetBlkAttrib - Get Block Attribute value
					; Arguments: 2
					;   BlkOrEntity = Block or entity name
					;   AttrTag$ = Tag label of attribute
					; Returns: Attribute value
					; If BlkOrEntity is a block name, it gets the attribute of the first block found.
					;-------------------------------------------------------------------------------
  (defun GetBlkAttrib (BlkOrEntity AttrTag$    /	   AttrVal$
		       EntAttr$	   EntList@    EntName^	   EntTag$
		       EntType$	   Passed      SS&
		      )
    (if	(= (type BlkOrEntity) 'ENAME)
      (progn
	(setq EntName^ BlkOrEntity
	      EntList@ (entget EntName^)
	      EntType$ (cdr (assoc 0 EntList@))
	)				;setq
	(if (and (= EntType$ "INSERT") (assoc 66 EntList@))
	  (setq Passed t)
	)				;if
      )					;progn
      (if (setq
	    SS&	(ssget
		  "x"
		  (list '(0 . "INSERT") '(66 . 1) (cons 2 BlkOrEntity))
		)
	  )
	(setq EntName^ (ssname SS& (1- (sslength SS&)))
	      EntList@ (entget EntName^)
	      Passed   t
	)				;setq
      )					;if
    )					;if
    (if	Passed
      (while (/= (cdr (assoc 0 EntList@)) "SEQEND")
	(setq EntList@ (entget EntName^)
	      EntType$ (cdr (assoc 0 EntList@))
	      EntAttr$ (cdr (assoc 1 EntList@))
	      EntTag$  (cdr (assoc 2 EntList@))
	)				;setq
	(if (= EntType$ "ATTRIB")
	  (if (= EntTag$ (strcase AttrTag$))
	    (setq AttrVal$ EntAttr$)
	  )
	)				;if
	(setq EntName^ (entnext EntName^))
      )					;while
    )					;if
    AttrVal$
  )					;defun GetBlkAttrib
					;-------------------------------------------------------------------------------
					; PutBlkAttrib - Put Block Attribute value
					; Arguments: 3
					;   BlkOrEntity = Block or entity name
					;   AttrTag$ = Tag label of attribute
					;   AttrVal$ = New Value for attribute
					; Returns: Changes attribute value
					; If BlkOrEntity is a block name, it changes only the first block found.
					;-------------------------------------------------------------------------------
  (defun PutBlkAttrib (BlkOrEntity AttrTag$    AttrVal$	   /
		       EntAttr$	   EntList@    EntName^	   EntTag$
		       EntType$	   First       Passed	   SS&
		      )
    (if	(= (type BlkOrEntity) 'ENAME)
      (progn
	(setq EntName^ BlkOrEntity
	      EntList@ (entget EntName^)
	      EntType$ (cdr (assoc 0 EntList@))
	)				;setq
	(if (and (= EntType$ "INSERT") (assoc 66 EntList@))
	  (setq	Passed t
		First t
	  )
	)				;if
      )					;progn
      (if (setq
	    SS&	(ssget
		  "x"
		  (list '(0 . "INSERT") '(66 . 1) (cons 2 BlkOrEntity))
		)
	  )
	(setq EntName^ (ssname SS& (1- (sslength SS&)))
	      EntList@ (entget EntName^)
	      Passed   t
	      First    t
	)				;setq
      )					;if
    )					;if
    (if	Passed
      (while (/= (cdr (assoc 0 EntList@)) "SEQEND")
	(setq EntList@ (entget EntName^)
	      EntType$ (cdr (assoc 0 EntList@))
	      EntTag$  (cdr (assoc 2 EntList@))
	)				;setq
	(if (= EntType$ "ATTRIB")
	  (if (and (= EntTag$ (strcase AttrTag$)) First)
	    (progn
	      (entmod
		(subst (cons 1 AttrVal$) (assoc 1 EntList@) EntList@)
	      )
	      (entupd EntName^)
	      (setq First nil)
	    )				;progn
	  )				;if
	)				;if
	(setq EntName^ (entnext EntName^))
      )					;while
    )					;if
    (princ)
  )					;defun PutBlkAttrib
  (defun br:CheckRowStringCount	(num lst / o)
    (setq o 0)
    (foreach n (cdr (nth num lst))
      (setq o (+ o (strlen (cdr n))))
    )
    o
  )

  (defun num-char-p (num)
    ;; Does (chr num) represent a numeric character (0...9)?
    (<= 48 num 57)
  )
  (defun d (str)
    (vl-list->string
      (vl-remove-if-not
	'num-char-p
	(vl-string->list str)
      )
    )
  )
  (setq lstAttribs '())
  (if (and (setq eBlock (entsel "\nSelect material row to bump: "))
	   (= (type eBlock) 'LIST)
	   (= (type (car eBlock)) 'ENAME)
	   (setq oBlock (m:object eBlock))
	   (= (vla-get-hasAttributes oBlock) :vlax-true)
	   (setq oAttributes (m:safelist (vla-getattributes oBlock)))
	   (setq oRow (nentselp (last eBlock)))
	   (setq oRow (m:object oRow))
	   (= (vla-get-ObjectName oRow) "AcDbAttribute")
	   (setq sRow (d (vla-get-tagstring oRow)))
      )
    (foreach n oAttributes
      (setq i (d (vla-get-tagstring n)))
      (if (assoc i lstAttribs)
	(setq lstAttribs
	       (subst
		 (append
		   (assoc i lstAttribs)
		   (list (cons (vla-get-tagstring n) (vla-get-textstring n)))
		 )
		 (assoc i lstAttribs)
		 lstAttribs
	       )
	)
	(setq lstAttribs
	       (append
		 lstAttribs
		 (list
		   (cons
		     i
		     (list (cons (vla-get-tagstring n) (vla-get-textstring n))
		     )
		   )
		 )
	       )
	)
      )
    )
  )
  (setq	iRow	  (1- (atoi sRow))
	lstRows	  (list (nth iRow lstAttribs))
	bEmptyRow nil
	iEmptyRow (br:CheckRowStringCount iRow lstAttribs)
  )
  (while (or (= iRow (length lstAttribs))
	     (> iEmptyRow 0)
	 )
    (setq iRow	    (1+ iRow)
	  lstRows   (append lstRows (list (nth iRow lstAttribs)))
	  iEmptyRow (br:CheckRowStringCount iRow lstAttribs)
    )
  )
  (foreach n (reverse (cdr lstRows))
    (foreach j (cdr n)
      (PutBlkAttrib
	(car eBlock)
	(car j)
	(getBlkAttrib
	  (car eBlock)
	  (vl-string-subst
	    (itoa (1- (atoi (d (car j)))))
	    (d (car j))
	    (car j)
	  )
	)
      )
    )
  )
  (foreach n (cdr (car lstRows))
    (PutBlkAttrib (car eBlock) (car n) "")
  )
  (princ)
)

I do not currently have any available time and do not plan on supporting this any further at the moment.

[BIG-AL]

A different way around maybe is ignore tag searching rather use attribute creation order, then you can update attributes using the creation order, att1 has same tag name as att5 etc. This is usefull when a block has like a table approach a multi row blocks can be manipulated this way as well only extra is say getting Y axis sorted order on entity name.

[MajorWedgee]

It sounds like you've got what I'm looking for Opie, thanks for the effort. I understand you're busy, but I'm getting an error after selecting the attribute. Would you be able to help me out?

I get this
"Command: BUMPROW
Select material row to bump: ; error: no function definition: M:OBJECT
Command:"

[Opie]

Problem with using internal code to help external requests. That code is converting a ename to a vla-object. You will need to take the first element of the list provided to that subroutine and use the vlax-ename->vla-object function. Does that make sense? Otherwise, you might search my history to see if I have posted it somewhere in the forums.

Edit: You will need more than that.

Here

;_ Convert Safearray to list
(defun m:safelist (value)
  (if (= (type value) 'VARIANT)
    (setq value (m:variantvalue value))
  )
  (setq value (vl-catch-all-apply 'vlax-safearray->list (list value)))
  (if (vl-catch-all-error-p value)
    nil
    value
  )
)
;_ Get value of variant
(defun m:variantvalue (value)
  (setq value (vl-catch-all-apply 'vlax-variant-value (list value)))
  (if (vl-catch-all-error-p value)
    nil
    value
  )
)
(defun m:object	(entity / object)
  (cond ((and (= (type entity) 'LIST)
	      (= (type (car entity)) 'ENAME)
	 )
	 (setq ename (car entity))
	)
	((and (= (type entity) 'LIST)
	      (assoc -1 entity)
	      (= (cdr (assoc -1 entity)))
	 )
	 (setq ename (cdr (assoc -1 entity)))
	)
	((= (type entity) 'ENAME)
	 (setq ename entity)
	)
  )
  (setq ename (vl-catch-all-apply 'vlax-ename->vla-object (list ename)))
  (if (vl-catch-all-error-p ename)
    nil
    ename
  )
)

The first if statement should probably be expanded to include the code that follows it. Of course, you will need to enclose all of that in a progn function. Otherwise, it will error out if an attribute is not selected.

[MajorWedgee]

It's working great now, Thanks Opie! This is huge for me, thank you, thank you, thank you!