Need to go from x,y,z to x,y coordinates

Lee developed this routine for me and it works great but I need the updated attributes to show the x,y coordintes. This routine gives the x,y,z coordinates. Can anyone help!

(defun lcoord (/ lEnt bEnt vEnt sPt ePt aEnt aEntLst)
(vl-load-com)
(if (and (setq lEnt (car (entsel "\nSelect Line, Polyline, LWPolyline, Spline or Arc to fill out the PT1 and PT2 attributes of the 
Footage block > ")))
(member (cdr (assoc 0 (entget lEnt))) '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC"))
(setq bEnt (car (entsel "\nSelect Destination Block > ")))
(= (cdr (assoc 0 (entget bEnt))) "INSERT")
(= (cdr (assoc 66 (entget bEnt))) 1))
(progn
(setq vEnt (vlax-ename->vla-object lEnt)
sPt (vlax-curve-getStartPoint vEnt)
ePt (vlax-curve-getEndPoint vEnt)
aEnt (entnext bEnt))
(while (/= "SEQEND" (cdr (assoc 0 (setq aEntLst (entget aEnt)))))
(cond ((= "PT1" (cdr (assoc 2 aEntLst)))
(setq aEntLst (subst (cons 1 (strcat (in2ft (car sPt)) (chr 32) ","
(chr 32) (in2ft (cadr sPt)) (chr 32) ","
(chr 32) (in2ft (caddr sPt))))
(assoc 1 aEntLst) aEntLst))
(entmod aEntLst))
((= "PT2" (cdr (assoc 2 aEntLst)))
(setq aEntLst (subst (cons 1 (strcat (in2ft (car ePt)) (chr 32) ","
(chr 32) (in2ft (cadr ePt)) (chr 32) ","
(chr 32) (in2ft (caddr ePt))))
(assoc 1 aEntLst) aEntLst))
(entmod aEntLst)))
(setq aEnt (entnext aEnt)))))

Change these 2 lines:

(chr 32) (in2ft (cadr ePt)) (chr 32) ","

(chr 32) (in2ft (caddr ePt))))

to

(chr 32) (in2ft (cadr ePt))))

Worked like a charm! Thank you very much.

I have another problem. I have a routine to move a block and then update the coordintes by clicking on the block twice after moving it. It works fine except for one thing. The format is wrong.

This how it looks after update... 7593.37,615.43,0.00

This is how it needs it to look after update .... 759'-3.37",61'-5.43",0.00

I also need to get rid of the z coordinates (0.00).

I would appreciate any help you can provide.

(defun c:moveupdate_coord (/ pBlk dBlk ptBlk aEnt aEntLst)
(princ "\nMove Block into place ")
(command "move" pause "" pause pause "") 
(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 (= "COORD" (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")))
(command "vbarun" "twcstartend")
(princ)) 

OK I'll step in since Lee must be tuckered out

change:

(setq aEntLst (subst (cons 1 (strcat (rtos (car ptBlk) 2 2) ","

(rtos (cadr ptBlk) 2 2) ","

(rtos (caddr ptBlk) 2 2)))

to

(setq aEntLst (subst (cons 1 (strcat (rtos (car ptBlk) 3 2) ","

(rtos (cadr ptBlk) 3 2)))

The "3" is for Engineering units, the "2" is the precision

Nice one Carl,

I see that in the first post cabltv did not post the local function that I wrote for use with that code (namely in2ft).

I realised that the return was in inches, but need to show it in feet and inches.

If the

(rtos [real] 3 2)

works, that is a great work around - but as usual I have to find the difficult solution to all my problems

One more thing - cabltv, in future, could you post your code using

 [/b][color=Red][i]"code goes here"[/i][/color] [b][/ code][/b]
 
obviously without the spaces in the second set of brackets.

CarlB: Thanks for all of your help! I appreciate the time you took to fix my problem.

Lee: Thank you very much for the original code. I did not realize that the requirements were feet/inches when I firsy asked for your help. I will follow your suggestion above in the future.

One other question and then I will leave both of you alone.

Lee created the code below for me and of course, it works great! There is one problem I need to resolve and that is the coordinates in the "PT1" and "PT2" attributes has a space between the coma that I don't need. Example:xx'-xx" , xx'-xx".

Is there an easy way to remove the space between the coma?

(defun lcoord (/ lEnt bEnt vEnt sPt ePt aEnt aEntLst)
(command "pickbox" "8")
(vl-load-com)
(if (and (setq lEnt (car (entsel "\nSelect Line, Polyline, LWPolyline, Spline or Arc to fill out the PT1 and PT2 attributes of the 
Footage block > ")))
(member (cdr (assoc 0 (entget lEnt))) '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC"))
(setq bEnt (car (entsel "\nSelect Destination Block > ")))
(= (cdr (assoc 0 (entget bEnt))) "INSERT")
(= (cdr (assoc 66 (entget bEnt))) 1))
(progn
(setq vEnt (vlax-ename->vla-object lEnt)
sPt (vlax-curve-getStartPoint vEnt)
ePt (vlax-curve-getEndPoint vEnt)
aEnt (entnext bEnt))
(while (/= "SEQEND" (cdr (assoc 0 (setq aEntLst (entget aEnt)))))
(cond ((= "PT1" (cdr (assoc 2 aEntLst)))
(setq aEntLst (subst (cons 1 (strcat (in2ft (car sPt)) (chr 32) ","
; (chr 32) (in2ft (cadr sPt)) (chr 32) ","
; (chr 32) (in2ft (caddr sPt))))
(chr 32) (in2ft (cadr ePt))))
(assoc 1 aEntLst) aEntLst))
(entmod aEntLst))
((= "PT2" (cdr (assoc 2 aEntLst)))
(setq aEntLst (subst (cons 1 (strcat (in2ft (car ePt)) (chr 32) ","
; (chr 32) (in2ft (cadr ePt)) (chr 32) ","
; (chr 32) (in2ft (caddr ePt))))
(chr 32) (in2ft (cadr ePt))))
(assoc 1 aEntLst) aEntLst))
(entmod aEntLst)))
(setq aEnt (entnext aEnt)))))
(command "pickbox" "4")
(command "vbarun" "twcstartend")
(princ)) 

This will remove spaces:

(defun lcoord  (/ lEnt bEnt vEnt sPt ePt aEnt aEntLst)
 (command "pickbox" "8")
 (vl-load-com)
 (if (and (setq lEnt
         (car
           (entsel
             "\nSelect Line, Polyline, LWPolyline, Spline or Arc to fill out the PT1 and PT2 attributes of the 
Footage block > "     )))
      (member (cdr (assoc 0 (entget lEnt))) '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC"))
      (setq bEnt (car (entsel "\nSelect Destination Block > ")))
      (= (cdr (assoc 0 (entget bEnt))) "INSERT")
      (= (cdr (assoc 66 (entget bEnt))) 1))
   (progn
     (setq vEnt (vlax-ename->vla-object lEnt)
       sPt     (vlax-curve-getStartPoint vEnt)
       ePt     (vlax-curve-getEndPoint vEnt)
       aEnt (entnext bEnt))
     (while (/= "SEQEND" (cdr (assoc 0 (setq aEntLst (entget aEnt)))))
   (cond ((= "PT1" (cdr (assoc 2 aEntLst)))
          (setq aEntLst (subst (cons 1
                     (strcat (in2ft (car sPt))
 ; (chr 32)
                         ","
 ; (chr 32) (in2ft (cadr sPt)) (chr 32) ","
 ; (chr 32) (in2ft (caddr sPt))))
 ; (chr 32)
                         (in2ft (cadr ePt))))
                   (assoc 1 aEntLst)
                   aEntLst))
          (entmod aEntLst))
         ((= "PT2" (cdr (assoc 2 aEntLst)))
          (setq aEntLst (subst (cons 1
                     (strcat (in2ft (car ePt))
 ; (chr 32)
                         ","
 ; (chr 32) (in2ft (cadr ePt)) (chr 32) ","
 ; (chr 32) (in2ft (caddr ePt))))
 ; (chr 32)
                         (in2ft (cadr ePt))))
                   (assoc 1 aEntLst)
                   aEntLst))
          (entmod aEntLst)))
   (setq aEnt (entnext aEnt)))))
 (command "pickbox" "4")
 (command "vbarun" "twcstartend")
 (princ))

By the way, do you know that for the attribute tag PT1, the way it has been altered means that you get the x coordinate of the startpoint and y coordinate of the endpoint - is this how you want it to be?

Also, remember to post the sub-funtion as well as the main function, so that testing can be possible

Thanks again Lee.

I know I said I would leave you and CarlB alone but I just lealized one more problem. The above code (that works great) adds trailing zeros and I need to get rid of them.

Example:

2474002.00'-6.42",7002900.00'-4.24"

Is there a quick fix for removing the ".00".

Thanks again.

Every solution breeds new problems.

Try setting DIMZIN to 0 before running it. If that works you might just include a line in the routine:

(setvar "DIMZIN" 0)

It is already set to "0".

I've only seen snippets of your code and don't know which part is giving you troubles. But from a post by Lee I'm guessing it my be in the "in2ft" subroutine:

(defun in2ft (num / ft in)
 (setq ft (fix (/ num 12.0))
   in (rem num 12.0))
 (strcat (rtos ft 2 2) (chr 39) (chr 45)
     (rtos in 2 2) (chr 34)))

If so, just change the

(strcat (rtos ft 2 2) to

(strcat (rtos ft 2 0)

That's it!!!

Perfect!!!

Thank you very much.

I PROMISE TO LEAVE YOU AND LEE ALONE

(For a while)

Cheers Carl for sorting that, I have been a bit busy these last few days

I wasn't sure what accuracy cabltv wanted the units to be to, so I just left it to two decimal places to be safe.

Glad you got it sorted cabltv