[编程交流] 坐标未正确更新

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

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