Replace vl-sort with user selection order - Block Attribute Number Sequencing

[rayg11757]

Below is attribute-numbering code from ASMI and modified by Fixo and pBe. Attached is the link to the original post, if anyone is interested: http://www.cadtutor.net/forum/showthread.php?20103-Sequential-numbering-a-single-attribute-value-in-multiple-attribute-block/page4

 

The code automatically numbers attributes in dynamic blocks. I am trying unsuccessfully to modify the code so that the numbering follows the user pick order, instead of automatic numbering based on the block's position on the drawing.

 

It looks like the blocks are sorted and placed in a list (sLst). I am trying to eliminate the sorting portion of the code so the attributes enter the list in the pick order. If I remove the vl-sort code and associated parentheses, the program bombs.

 

Thank you for any help or suggestions.

Ray

 

Excerpt from the lisp program:

[color=purple](setq sLst[/color]
[color=purple]             (mapcar 'vlax-ename->vla-object[/color]
[color=purple]     (mapcar 'car[/color]
[color=purple][b]      (vl-sort[/b][/color]
[color=purple][b]       (vl-sort[/b][/color]
[color=purple]         (mapcar '(lambda(x)(list x(cdr(assoc 10 (entget x)))))[/color]
[color=purple]           (vl-remove-if 'listp[/color]
[color=purple]                     (mapcar 'cadr(ssnamex blSet))))[/color]
[color=purple]               '(lambda(a b)(<(caadr a)(caadr b))))[/color]
[color=purple]             '(lambda(a b)(>(cadadr a)(cadadr b)))))))[/color]

 

The entire program:

(defun c:mnum(/ );stStr stNum nLen cAtr dLst blName;ASMI original program
;;;          fLst blLst blSet aName sLst lZer aStr);pBe Modifications for Dynamic Blocks
 (vl-load-com)
 (defun _effname (ssobj bn / e selfil)
 (setq selfil (ssadd))
 (repeat (sslength ssobj)
   (if    (eq (vla-get-effectivename
         (vlax-ename->vla-object (setq e (ssname ssobj 0)))
       ) bn
   )  (ssadd e selfil)
   )  (ssdel e ssobj)
 )  (if (zerop (sslength selfil)) nil selfil)
)
 (if
   (and
     (setq stStr (getstring "\nSpecify start number: "))
;;;      (setq stNum (numberp (read  stStr)))
           (setq stNum (read  stStr))
     (setq nLen (strlen stStr))
     ); end and
   (progn
     (if
   (and
      (setq cAtr (nentsel "\nPick attribute > "))
      (= "ATTRIB"(cdr(assoc 0(setq dLst(entget(car cAtr))))))
     ); end and
   (progn
     (setq blName
       (vla-get-EffectiveName
          (vla-ObjectIDToObject
         (vla-get-ActiveDocument
            (vlax-get-acad-object))
               (vla-get-OwnerID
                  (vlax-ename->vla-object(car cAtr)))))
       fLst(list '(0 . "INSERT")(cons 2 (strcat blName ",`*U*"))'(66 . 1))
       aName(cdr(assoc 2 dLst))
       ); end setq
     (princ "\n<<< Select blocks to number >>> ")
     (if
       (and (setq blSet (ssget fLst))
            (setq blSet (_effname  blSet blName)))
       (progn
[color=purple];;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;[/color]
[color=purple](setq sLst[/color]
[color=purple]           (mapcar 'vlax-ename->vla-object[/color]
[color=purple]     (mapcar 'car[/color]
[color=purple]      (vl-sort[/color]
[color=purple]       (vl-sort[/color]
[color=purple]         (mapcar '(lambda(x)(list x(cdr(assoc 10 (entget x)))))[/color]
[color=purple]           (vl-remove-if 'listp[/color]
[color=purple]                     (mapcar 'cadr(ssnamex blSet))))[/color]
[color=purple]               '(lambda(a b)(<(caadr a)(caadr b))))[/color]
[color=purple]             '(lambda(a b)(>(cadadr a)(cadadr b)))))))[/color]
[color=purple];;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;[/color]
  (foreach i sLst
          (setq lZer "")
          (repeat(- nLen(strlen
     (itoa stNum)))
        (setq lZer(strcat lZer "0"))
        ); end repeat
          (setq atLst
             (vlax-safearray->list
            (vlax-variant-value
              (vla-GetAttributes i))))
          (foreach a atLst
        (if
          (= aName(vla-get-TagString a))
             (vla-put-TextString a
           (strcat lZer(itoa stNum)))
          ); end if
        ); end foreach
        (setq stNum(1+ stNum))
          ); end foreach
         ); end progn
       (princ "\nEmpty selection! Quit. ")
       ); end if
     ); end progn
   (princ "\nThis isn't attribute! Quit. ")
   ); end if
     ); end progn
   (princ "\nInvalid start number! Quit. ")
   ); end if
 (princ)
 )

[pBe]

Do you want to modify this in a way that when you select the attribute the value is assigned to the selected attribute entity instantaneously?

[alanjt]

If I've read the excerpt correctly, you should be able to replace it with the following bit of code:

 

(setq sLst ((lambda (ss / i l)
             (if (eq (type ss) 'PICKSET)
               (repeat (setq i (sslength ss))
                 (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
               )
             )
           )
            blSet
          )
)

[pBe]

If I've read the excerpt correctly, you should be able to replace it with the following bit of code:

 

(setq sLst ((lambda (ss / i l)
             ......
)

 

You nailed it Alan

[alanjt]

You nailed it Alan

 

Sweet. I'm still good for something.

[rayg11757]

Sweet. I'm still good for something.

 

pBe, Instantaneous would be good, but I agree that Alan "nailed it."

 

Thank you for the help. Someday I hope to understand the lisp programming to the level of you guys.

 

Ray