Jump to content

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


rayg11757

Recommended Posts

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

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 :thumbsup:

Link to comment
Share on other sites

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

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...