rayg11757 Posted July 16, 2013 Share Posted July 16, 2013 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) ) Quote Link to comment Share on other sites More sharing options...
pBe Posted July 17, 2013 Share Posted July 17, 2013 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? Quote Link to comment Share on other sites More sharing options...
alanjt Posted July 17, 2013 Share Posted July 17, 2013 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 ) ) Quote Link to comment Share on other sites More sharing options...
pBe Posted July 17, 2013 Share Posted July 17, 2013 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 Quote Link to comment Share on other sites More sharing options...
alanjt Posted July 17, 2013 Share Posted July 17, 2013 You nailed it Alan Sweet. I'm still good for something. Quote Link to comment Share on other sites More sharing options...
rayg11757 Posted July 18, 2013 Author Share Posted July 18, 2013 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.