Jump to content

AutoCAD coordinates


cabltv1

Recommended Posts

Please help.

I need an AutoCAD VBA routine that can do the following:

1) Pick an existing block to get it's coordinates.

2) Pick another block and put the first block's coordinates into the picked block's attribute with the tag "PT1".

Link to comment
Share on other sites

Welcome to CADTutor cabltv1, hope you like it here.

 

This thread may get more replies in the VBA/AutoLISP customisation forum - see if you can get a moderator to move it for you.

 

But - DO NOT DUPLICATE this thread in that forum - get this one moved.

Link to comment
Share on other sites

Your wish is my command :)

 

Cabltv - is this something that you need to do often or is it a one time thing? Sounds to me like it could be done via exporting the coordinates to Excel and ..then...I'm lost...

Link to comment
Share on other sites

With this you can do one block after another:

 

(defun c:attpt (/ pBlk dBlk ptBlk aEnt aEntLst)
 (while (and (setq pBlk (car (entsel "\nSelect Block to Retrieve Coordinates >  ")))
         (setq dBlk (car (entsel "\nSelect Destination Block >  ")))
         (= (cdr (assoc 0 (entget pBlk))) "INSERT" (cdr (assoc 0 (entget dBlk))))
         (= (cdr (assoc 66 (entget dBlk))) 1))
   (setq ptBlk (cdr (assoc 10 (entget pBlk)))
     aEnt (entnext dBlk))
   (while (/= "SEQEND" (cdr (assoc 0 (setq aEntLst (entget aEnt)))))
     (if (= "PT1" (cdr (assoc 2 aEntLst)))
   (progn
   (setq aEntLst (subst (cons 1 (strcat (rtos (car ptBlk) 2 2) ","
                        (rtos (cadr ptBlk) 2 2) ","
                        (rtos (caddr ptBlk) 2 2)))
                (assoc 1 aEntLst) aEntLst))
   (entmod aEntLst)))
     (setq aEnt (entnext aEnt))))
 (command "_regenall")
 (princ))

Link to comment
Share on other sites

There is one other thing.

It works great but I need the function to stop after picking the second block with the "PT1" attribute without having to hit the escape key.

Link to comment
Share on other sites

Here ya go buddy:

 

(defun c:attpt (/ pBlk dBlk ptBlk aEnt aEntLst)
 (if (and (setq pBlk (car (entsel "\nSelect Block to Retrieve Coordinates >  ")))
         (setq dBlk (car (entsel "\nSelect Destination Block >  ")))
         (= (cdr (assoc 0 (entget pBlk))) "INSERT" (cdr (assoc 0 (entget dBlk))))
         (= (cdr (assoc 66 (entget dBlk))) 1))
   (progn
   (setq ptBlk (cdr (assoc 10 (entget pBlk)))
     aEnt (entnext dBlk))
   (while (/= "SEQEND" (cdr (assoc 0 (setq aEntLst (entget aEnt)))))
     (if (= "SIZE" (cdr (assoc 2 aEntLst)))
   (progn
   (setq aEntLst (subst (cons 1 (strcat (rtos (car ptBlk) 2 2) ","
                        (rtos (cadr ptBlk) 2 2) ","
                        (rtos (caddr ptBlk) 2 2)))
                (assoc 1 aEntLst) aEntLst))
   (entmod aEntLst)))
     (setq aEnt (entnext aEnt)))
 (command "_regenall")))
 (princ))

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