Jump to content

Lisp for placing a block with attributes to multiple points


Jadeous

Recommended Posts

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

 

Hahahaha... cheers mate :)

 

Any other questions, just ask :)

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