Lisp to sequentially fill in attributes based on selection

[PrimeTimeAction]

I have drawing with a bunch of blocks with attributes tags. Among the attribute tags the following three are of importance:

• ID
• Next
• Previous

The ID attribute values are already entered in the blocks and are unique. I would like to have a lisp that will enable me to sequentially pick the blocks and fill in the Next and Previous attributes tags with the ID values. Attached is sample file showing the starting point and expected end result. Any ideas how to go about making this lisp?

 

EDIT: I have been able to modify a lisp from @Lee Mac as fist step. But it only works in forward direction i.e   to fill in Previous attribute.  Im thinking that to get the functionality to fill in "Next", we cannot use single item selection, we will have to use list selection to  get the iD of next block and fill in the current block in "Next" Attribute.

So the operation sequence will be Start lisp> Click all blocks one by one> hit Enter

 

Any help in achieving this will be welcome.

 

(defun c:ca ( / _SelectBlockWithTag a b des src tag ) (vl-load-com)

 (setq src "ID"  ; Source Attribute Tag
       des "Previous"  ; Destination Attribute Tag
 )

 (defun _SelectBlockWithTag ( tag / e a ) (setq tag (strcase tag))
   (while
     (progn (setvar 'ERRNO 0) (setq e (car (entsel (strcat "\nSelect Block with attribute " tag ": "))))
       (cond
         ( (= 7 (getvar 'ERRNO))
           (princ "\nMissed, Try Again.")
         )
         ( (not e)
           nil
         )
         ( (and
             (eq "INSERT" (cdr (assoc 0 (entget e))))
             (= 1 (cdr (assoc 66 (entget e))))
           )
           (if
             (not
               (setq a
                 (vl-some
                   (function
                     (lambda ( x )
                       (if (eq tag (strcase (vla-get-tagstring x))) x)
                     )
                   )
                   (vlax-invoke (vlax-ename->vla-object e) 'getattributes)
                 )
               )
             )
             (princ (strcat "\nBlock does not contain tag " tag "."))
           )
         )
         ( (princ "\nInvalid Object Selected.") )
       )
     )
   )
   a
 )

 (while
   (and
     (setq a (_SelectBlockWithTag src))
     (setq b (_SelectBlockWithTag des))
   )
   (vla-put-textstring b (vla-get-textstring a))
 )
 (princ)
)

 

 

SampleDrwaing.dwg

Edited August 21 by PrimeTimeAction

[mhupp]

I would push this to excel with attout from express tools if the ID is already setup. Then use some excel xlookup formulas to fill in the other two save and use attin to update blocks.

[BIGAL]

Because you have a block with 3 attributes you don't need tag names, you can use the attribute order. Need to work out an attribute order taking into account up to 3 blocks. need to have checks about is attribute value a blank.

 

It will be a loop type thing as block att values

 

Will have a think should be just a case of making correct list of all blocks.

 

 

[PrimeTimeAction]

The sample drawing i posted is a simplified version to explain the issue, the actual drawings have multiple blocks that are not necessarily touching so its impossible to know in excel which block is the proper "Next" or "Previous". Also the blocks have more attributes than these three and different number of attributes in different order, that is why tag names will be needed.

Edited August 22 by PrimeTimeAction

[mhupp]

for BIGAL to think on then.

• the command asks the user to draw a polyline.
• User draws the polyline crossing over top of the blocks they want to input.
• lisp then calculates the points of the polyline and using the ssget with fence selects blocks with attributes that have ID.
• sort the blocks in the order of how they fall on the polyline.
• after sorting first one only has next ID inputted, then each block after pulls previous and next block ID's .
• last only inputs previous ID
• delete polyline before exiting lisp.

[PrimeTimeAction]

29 minutes ago, mhupp said:

for BIGAL to think on then.

• the command asks the user to draw a polyline.
• User draws the polyline crossing over top of the blocks they want to input.
• lisp then calculates the points of the polyline and using the ssget with fence selects blocks with attributes that have ID.
• sort the blocks in the order of how they fall on the polyline.
• after sorting first one only has next ID inputted, then each block after pulls previous and next block ID's .
• last only inputs previous ID
• delete polyline before exiting lisp.

Why the need for fence selection, cant it be done with a simple loop with a counter (ssget> sslength with a counter), if needed the ID can be written to a system variable and retrieved in the next cycle.

Edited August 22 by PrimeTimeAction

[Jonathan Handojo]

2 hours ago, PrimeTimeAction said:

Why the need for fence selection, cant it be done with a simple loop with a counter (ssget> sslength with a counter), if needed the ID can be written to a system variable and retrieved in the next cycle.

A fence selection will ensure that your selection set is created in the order that the fence is created. That way, you have the right next's and previous'. However, if you want to click them one at a time as stated in the OP, then this will do for now. Though I don't believe it's the most efficient idea around:

 

(defun c:foo ( / *error* acadobj activeundo adoc blk blk_curr blk_prev enx pck spc)
    ;; --- My Usual Intro --- ;;
    (defun *error* ( msg )
        (vla-EndUndoMark adoc)
        (if pck (setvar "PICKADD" pck))
        (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
            (princ (strcat "Error: " msg))
        )
    )
    (setq
        acadobj (vlax-get-acad-object)
        adoc (vla-get-ActiveDocument acadobj)
    )
    (if (= (getvar 'cvport) 1) 
        (setq spc (vla-get-Block (vla-get-ActiveLayout adoc)))
        (setq spc (vla-get-ModelSpace adoc))
    )
    (setq pck (getvar "PICKADD"))
    (setvar "PICKADD" 2)
    (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T))
    ;; --- My Usual Intro --- ;;
    
    (while
        (progn
            (setvar "errno" 0)
            (initget "Exit")
            (setq blk (entsel "\nSelect block in sequence [Exit] <exit>: "))
            (cond
                (   (= (getvar "errno") 7) (princ "\nNothing selected."))
                (   (member blk '("Exit" nil)) (setq blk nil))
                (   (not (wcmatch (cdr (assoc 0 (setq blk (car blk) enx (entget blk)))) "INSERT"))
                    (princ "\nObject is not a block")
                )
                (   (not (= (cdr (assoc 66 enx))))
                    (princ "\nBlock does not contain any attributes")
                )
                (   (not blk_prev) (setq blk_prev (vlax-ename->vla-object blk)))
                (   t
                    (setq blk_curr (vlax-ename->vla-object blk))
                    (LM:vl-setattributevalue blk_prev "Next" (cond ((LM:vl-getattributevalue blk_curr "ID")) ("No ID Found")))
                    (LM:vl-setattributevalue blk_curr "Previous" (cond ((LM:vl-getattributevalue blk_prev "ID")) ("No ID Found")))
                    (setq blk_prev blk_curr)
                )
            )
        )
    )

    ;; --- My Usual Ending --- ;;
    (setvar "PICKADD" pck)
    (if (not activeundo) (vla-EndUndoMark adoc))
    (princ)
    ;; --- My Usual Ending --- ;;
)

;; 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)
    )
)

(vl-load-com)

 

[mhupp]

 

1 hour ago, PrimeTimeAction said:

...cant it be done with a simple loop with a counter (ssget> sslength with a counter)

 

Yes, but the fence option allow you to sort from a given direction or if the blocks are not in a straight line. You could also setup another command to run backwards.

if you have 15 blocks in a line it would be two clicks to populate the information into the blocks. rather then  the way your doing it by clicking each block individually.

 

2 hours ago, PrimeTimeAction said:

if needed the ID can be written to a system variable and retrieved in the next cycle.

 

Yes, its called ldata and is written into the drawing after saving the drawing. if you open it later it will remember using this method.

 

(or (setq ID (vlax-ldata-get "Block" "ID")) (setq ID "TEST")) ;first tries to pull existing ldata if it doesn't exist will set ID to "test"
(if (= nil (setq a (getstring (strcat "\nBlock ID [" (rtos ID 2) "]: "))))	'will prompt "Block ID [Test]:" you either enter in an diffrent id or right click to keep
  (vlax-ldata-put "Block" "ID")
  (vlax-ldata-put "Block" "ID" (setq ID a))
)

 

[Jonathan Handojo]

Or, a faster but rather inconvenient way is to use grread and move your mouse across, and as the cursor passes through the blocks in sequence...

[PrimeTimeAction]

16 hours ago, Jonathan Handojo said:

A fence selection will ensure that your selection set is created in the order that the fence is created. That way, you have the right next's and previous'. However, if you want to click them one at a time as stated in the OP, then this will do for now. Though I don't believe it's the most efficient idea around:

This does exactly what i want.

Thanks alot everybody for the help.