Coords not updating correctly

I got this code from Lee Mac a few months ago and it works great except for one thing. The "PT2" Y Coordinates are not filling out the attribute correctly.

Can somene please help.

Attributes:

Code:

; This is for updating PT1 and PT2 attributes in ftg block

;

(defun lcoord (/ lEnt bEnt vEnt sPt ePt aEnt aEntLst)

(command "pickbox" "8")

(vl-load-com)

(if (and (setq lEnt

(car

(entsel

"\nSelect Line then 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" "6")

(princ))

If that's mine, then I think it has been modified...

At first look, Why all the semicolons?

; This is for updating PT1 and PT2 attributes in ftg block
;
(defun lcoord (/ lEnt bEnt vEnt sPt ePt aEnt aEntLst)
(command "pickbox" "8")
(vl-load-com)
(if (and (setq lEnt
(car
(entsel
"\nSelect Line then 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))
[color=red]; (chr 32)[/color]
","
[color=red]; (chr 32) (in2ft (cadr sPt)) (chr 32) ","[/color]
[color=red]; (chr 32) (in2ft (caddr sPt))))[/color]
[color=red]; (chr 32)[/color]
(in2ft (cadr ePt))))
(assoc 1 aEntLst)
aEntLst))
(entmod aEntLst))
((= "PT2" (cdr (assoc 2 aEntLst)))
(setq aEntLst (subst (cons 1
(strcat (in2ft (car ePt))
[color=red]; (chr 32)[/color]
","
[color=red]; (chr 32) (in2ft (cadr ePt)) (chr 32) ","[/color]
[color=red]; (chr 32) (in2ft (caddr ePt))))[/color]
[color=red]; (chr 32)[/color]
(in2ft (cadr ePt))))
(assoc 1 aEntLst)
aEntLst))
(entmod aEntLst)))
(setq aEnt (entnext aEnt)))))
(COMMAND "PICKBOX" "6")
(princ)) 

That was just my original coding Buzzard, no worries.

That was just my original coding Buzzard, no worries.

I was not sure as I mentioned "At first look".

Just seemed odd.

Try this Cabltv:

(defun c:lcoord (/ ent blk Obj lObj ePt sPt)
 (vl-load-com)

 (defun *error* (msg)
   (if oPk (setvar "PICKBOX" oPk))
   (if (not
         (wcmatch
           (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " msg " >>")))
   (princ))

 (setq oPk (getvar "PICKBOX"))
 (setvar "PICKBOX" 
 
 (while
   (progn
     (setq ent (car (entsel "\nSelect Line: ")))
     (cond
       ((and (eq 'ENAME (type ent))
             (wcmatch (cdr (assoc 0 (entget ent))) "*LINE"))
        (while
          (progn
            (setq blk (car (entsel "\nSelect Block: ")))
            (cond
              ((and (eq 'ENAME (type blk))
                    (eq "AcDbBlockReference"
                      (vla-get-ObjectName
                        (setq Obj (vlax-ename->vla-object blk)))))
               (if (not (eq :vlax-true (vla-get-HasAttributes Obj)))
                 (princ "\n** Block is Not Attributed **")))
              (t (princ "\n** Object is not a Block **"))))))
       (t (princ "\n** Object is not a *Line **")))))

 (setq lObj (vlax-ename->vla-object ent)
       sPt (vlax-curve-getStartPoint lObj)
       ePt (vlax-curve-getEndPoint lObj))

 (foreach att (vlax-safearray->list
                (vlax-variant-value
                  (vla-getAttributes Obj)))
   (cond ((eq "PT1" (vla-get-tagString att))
          (vla-put-TextString att
            (strcat
              (in2ft (car sPt)) (chr 44)
              (in2ft (cadr sPt)) (chr 44)
              (in2ft (caddr sPt)))))
         ((eq "PT2" (vla-get-TagString att))
          (vla-put-TextString att
            (strcat
              (in2ft (car ePt)) (chr 44)
              (in2ft (cadr ePt)) (chr 44)
              (in2ft (caddr ePt)))))))
 
 (setvar "PICKBOX" oPk)
 (princ))
              

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

                  
   

I think it the original was modified incorrectly.

Lee created this for me a few months ago. I had forgotten that I commented out those sections. Now I know why.

I just removed the semicolons for those sections and tried loading the Lisp file and recieved the following error...

"Command: ; error: bad argument type: lentityp nil".

If I put the semicolons back in, it loads without error.

You won't be able to just remove the semicolons - your parentheses (brackets) will be incorrect.

Lee,

I went back to the original code from Jan 29th and tried it and the results are the same but I did not notice it at the time.

http://www.cadtutor.net/forum/showthread.php?t=31962&highlight=cabltv1

Did you try the LISP i posted above?

Lee,

I have been out most of the day and just had a chance to test it out.

As usual, it works perfectly!

Thank you very much for taking the time to fix this for me.

You are the BEST!!!

Well, glad it works