Lisp for placing a block with attributes to multiple points

[Jadeous]

I currently have a lisp that I can use to place a block with attribute and the number in the attribute will increase with each new placement. I love my lisp, but it get a little slow when I have more than 20 or so to do. I need a little tweak to it. I would like the option to select multiple points to attach to also. So here is the lisp and the two blocks I use it with.

 

Also, Can I rename the lisp command entry? How can it be done without messing it up? Thanks.

Points Block.dwg

apnumA.lsp

[Lee Mac]

For starters, the renaming is pretty easy and won't mess up the LISP, unless the syntax is referenced elsewhere.

 

Just change the text after "(defun c:", i.e. in your example, change apnumA

 

But remember not to change it to an in-built ACAD command name.

[Lee Mac]

Oh, 1 more thing - could you please upload the block sample in 2000 format

[Jadeous]

here is t he Block in 2000 ACAD

ACAD 2000-Points Block.dwg

[Lee Mac]

Thanks Jadeous, I shall have a look at it.

[Lee Mac]

I've got to admit, I don't like the way that the LISP is written, I would be tempted to re-write it. For instance, when inserting the new blocks, the loop cannot be exited without forcing an error.

 

Looking at your request again, I see that you want to insert at multiple points. Can you not already accomplish that with this LISP? With the while function, (although badly written into it), the blocks will be inserted as long as the user keeps clicking points.

 

What exactly are you hoping to tweak with this LISP?

[Jadeous]

I would like the option to either click one point at a time or choose multiple points and have the block populate the points. This lisp is great for picking a few points at a time, but when I have many, many points to address it can take awhile.

[Lee Mac]

Sorry if I am missing something, but when I use the LISP, I can pick loads of points one after another and the block will be inserted at each of those points. How else are you thinking of picking multiple points?

 

Do you mean having ACAD Points in the drawing that you select all in one go?

[Jadeous]

Yes. That would be what I am thinking of.

[Lee Mac]

Ok, I can engineer it so that it will place a block at each of the points, but, because we are using a selection set to retrieve the points, the placement of the blocks may appear "random" as one cannot determine the order of the entities in the selection set very easily.

[Jadeous]

That works for me as long as the blocks center on the points.

[Lee Mac]

Ok, will see what I can do for you Jadeous - sorry for the confusion earlier.

[Lee Mac]

Ok, try this:

 

;;; Numbering of the block with unique attribute with alignment (add 0 before number) of number

(defun c:apnuma     (/ *error* vLst oVar ptxt stxt num alig size tembl sel pss ptLst)
 (vl-load-com)

 (defun *error*  (msg)
   (mapcar 'setvar vLst oVar)
   (princ (strcat "\nError:" (strcase msg)))
   (princ))
 
 (or apnum:size  (setq apnum:size 1.0))
 (or apnum:num   (setq apnum:num 1))
 (or apnum:alig  (setq apnum:alig "1"))
 (or apnum:pref  (setq apnum:pref ""))
 (or apnum:suf   (setq apnum:suf ""))
 (or apnum:block (setq apnum:block "None"))
 (or apnum:sel   (setq apnum:sel "Multiple"))
 (setq    vLst '("CMDECHO" "ATTDIA" "ATTREQ")
   oVar (mapcar 'getvar vLst))
 (mapcar 'setvar vLst '(0 0 1))
 
 (setq    ptxt (getstring t (strcat "\nSpecify Prefix (SPACE for None) <" apnum:pref "> :")))  
 (cond ((= "" ptxt) (setq ptxt apnum:pref))
   ((= (chr 32) ptxt) (setq ptxt ""))
   ((and (/= "" ptxt) (/= (chr 32) ptxt)) (setq apnum:pref ptxt)))
 (setq    stxt (getstring t (strcat "\nSpecify Suffix (SPACE for None) <" apnum:suf "> :")))
 (cond ((= "" stxt) (setq stxt apnum:suf))
   ((= (chr 32) stxt) (setq stxt ""))
   ((and (/= "" stxt) (/= (chr 32) stxt)) (setq apnum:suf stxt)))
 (initget 6)
 (setq    num (getint (strcat "\nSpecify Start Number <" (itoa apnum:num) ">: ")))
 (if num (setq apnum:num num) (setq num apnum:num))
 (initget "1 10 100 1000 10000 100000")
 (setq    alig (getkword (strcat "\nSpecify alignment of number [1/10/100/1000/10000/100000] <" apnum:alig ">: ")))
 (if alig (setq apnum:alig alig) (setq alig apnum:alig))
 (initget 6)
 (setq    size (getreal (strcat "\nSpecify block scale <" (rtos apnum:size) ">: ")))
 (if size (setq apnum:size size) (setq size apnum:size))
 (setq    tembl (entsel (strcat "\nSelect block <" apnum:block "> : ")))
 (cond ((and apnum:block (not tembl) (tblsearch "BLOCK" apnum:block)))
       ((eq 1 (cdr (assoc 66 (entget (car tembl)))))
        (setq apnum:block (cdr (assoc 2 (entget (car tembl))))))
       (t (princ "\nBlock Doesn't Contain An Attribute! ") (setq apnum:block nil)))  
 (if apnum:block
   (progn
     (initget "Single Multiple")
     (setq sel (getkword (strcat "\nSpecify Selection Method [single/Multiple] <" apnum:sel "> :")))
     (if sel (setq apnum:sel sel) (setq sel apnum:sel))
     (cond ((= sel "Single")
        (while (setq inpt (getpoint "\nPick Insertion Point >"))
          (setq tembl (itoa apnum:num))
          (while (< (strlen tembl) (1- (strlen apnum:alig)))
        (setq tembl (strcat "0" tembl)))
          (command "_-insert" apnum:block "_s" size inpt "0" (strcat ptxt tembl stxt))
          (setq apnum:num (1+ apnum:num))))
       ((= sel "Multiple")
        (princ "\nSelect Points for Block Insertion...")
        (if (setq pss (ssget '((0 . "POINT"))))
          (progn
        (setq ptLst (mapcar '(lambda (x) (cdr (assoc 10 x)))
                    (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex pss))))))
        (foreach pt ptLst
          (setq tembl (itoa apnum:num))
          (while (< (strlen tembl) (1- (strlen apnum:alig)))
            (setq tembl (strcat "0" tembl)))
          (command "_-insert" apnum:block "_s" size pt "0" (strcat ptxt tembl stxt))
          (setq apnum:num (1+ apnum:num))))
          (princ "\n<!> No Points Selected <!>"))))))
 (mapcar 'setvar vLst oVar)
 (princ))
          

[Jadeous]

Would it be non man-ish to tell you I love you? ...... You ROCK man!!! Thank you sooooo much!!!!

[Lee Mac]

Would it be non man-ish to tell you I love you? ...... You ROCK man!!! Thank you sooooo much!!!!

 

Hahahaha... cheers mate

 

Any other questions, just ask

[Jadeous]

I'm good for now, but I'm sure we'll talk again sometime.