求助修改下面程序，在统计周长是，小数为多了一位，详见附图？

cxs259

;;;面积和长度统计程序
;;;highflybird kunming
;;;===================
(defun C:tt (/ f     ss      l      i      SSarea  totlen  entlen
      ename   name    obj     text-S  text-L  insPt0  height
      insPt1  insPt2  text-1  text-2  *APP    *DOC    *MSP
     )
  (vl-load-com)
  (setq *APP (vlax-get-acad-object))
  (setq *DOC (vla-get-activeDocument *APP))
  (setq *MSP (vla-get-Modelspace *DOC))
  (initget 1 "1 2 3")
  (setq f (getkword "\n请输入你要统计的<1>面积<2>长度<3>两者:"))
  (if
    (and
      (setq ss (ssget))
      (setq insPt0 (getpoint "\n请输入文字插入点: "))
      (setq height (getdist "\n请输入文字高度:"))
    )
    (progn
      (setq l (sslength ss))
      (setq i 0)
      (setq SSarea 0)
      (setq totlen 0)
      (setq insPt1 (vlax-3d-point insPt0))
      (setq insPt2 (polar insPt0 (* 1.5 Pi) (* 1.5 height)))
      (setq insPt2 (vlax-3d-point insPt2))  
      (cond
( (= f "1")
          (repeat l
            (func-1)
            (func-2)
            (setq i (1+ i))
          )
   (setq text-S (strcat (convert1 SSarea 6) "平方米"));总面积为:小数后6位
   (vla-addtext *MSP text-S insPt1 height)
)
( (= f "2")
          (repeat l
            (func-1)
            (func-3)
            (setq i (1+ i))
          )
   (setq text-L (strcat (convert1 totlen 3) "米"))    ;总长度为:小数后3位
   (vla-addtext *MSP text-L insPt2 height)
)
( (= f "3")
          (repeat l
            (func-1)
     (func-2)
            (func-3)
            (setq i (1+ i))
          )
   (setq text-S (strcat (convert1 SSarea 6) "平方米"));总面积为:小数后6位
   (setq text-L (strcat (convert1 totlen 3) "米"))    ;总长度为:小数后3位
   (vla-addtext *MSP text-S insPt1 height)
   (vla-addtext *MSP text-L insPt2 height)
)
      )
    )
    (alert "你没有选取物体或者输入正确的数据!")
  )
  (princ)
)
(defun func-1 ()
  (setq ename (ssname ss i))
  (setq obj (vlax-ename->vla-object ename))
  (setq elist (entget ename))
  (setq name (cdr (assoc 0 elist)))
)
;;面积的统计
(defun func-2 (/ p1 p2 p3 p4)
  (if (vlax-property-available-p obj "area")
    (setq SSarea (+ (vla-get-area obj) SSarea))
    (if (= name "SOLID")
      (setq p1 (cdr (assoc 10 elist))
            p2 (cdr (assoc 11 elist))
     p3 (cdr (assoc 12 elist))
            p4 (cdr (assoc 13 elist))
     SSarea (+ (area-of-verties (list p1 p2 p4 p3)) SSarea)
      )
    )
  )
)
;;长度的统计
(defun func-3 (/ p1 p2 p3 p4)
  (cond
    ( (= name "MLINE")
      (setq totlen (+ totlen (ml-length ename)))
    )
    ( (or (= name "ARC")
   (= name "CIRCLE")
   (= name "LINE")
   (= name "POLYLINE")
   (= name "LWPOLYLINE")
   (= name "SPLINE")
   (= name "ELLIPSE")
      )
      (setq entlen (vlax-curve-getdistatparam ename (vlax-curve-getendparam ename)))
      (setq totlen (+ totlen entlen))
    )
    ( (= name "SOLID")
      (setq p1 (cdr (assoc 10 elist)))
      (setq p2 (cdr (assoc 11 elist)))
      (setq p3 (cdr (assoc 12 elist)))
      (setq p4 (cdr (assoc 13 elist)))   
      (setq totlen (+ (length-of-verties (list p1 p2 p4 p3)) totlen))
    )
  )
)
;;Mline的长度
(defun ml-length (ename / j d ptlist)
  (foreach n (entget ename)
    (if (= (car n) 11)
      (setq ptlist (cons (cdr n) ptlist))
    )
  )
  (reverse ptlist)
  (setq j 0)
  (setq d 0)
  (repeat (1- (length ptlist))
    (setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))
    (setq j (1+ j))
  )
  d
)
;;单位转化
(defun convert (x n / tol_x fra_x int_x)
  (setq tol_x (/ x (expt 10 n)))
  (setq fra_x (rtos (- tol_x (fix tol_x)) 2 n))
  (setq fra_x (vl-string-left-trim "0" fra_x))
  (setq int_x (itoa (fix tol_x)))
  (strcat int_x fra_x)
)
(defun convert1 (x n / tol_x fra_x int_x)
  (setq tol_x (/ x (expt 10 n)))
  (setq fra_x (rtos (- tol_x (fix tol_x)) 2 3))
  (setq fra_x (vl-string-left-trim "0" fra_x))
  (setq int_x (itoa (fix tol_x)))
  (strcat int_x fra_x)
)
;;n个点的长度
(defun length-of-verties (pts / i l len pts1)
  (setq i -1 len 0)
  (setq pts1 (cons (last pts) pts))
  (repeat (length pts)
    (setq i   (1+ i))
    (setq l   (distance (nth i pts1) (nth (1+ i) pts1)))
    (setq len (+ l len))
  )  
)
;;n个点的面积
(defun area-of-verties (pts / i area PX0 PY0 x1 y1 x2 y2)
  (setq i 0)
  (setq area 0)
  (setq px0 (caar pts))
  (setq py0 (cadar pts))
  (repeat (- (length pts) 1)
    (setq x1 (- (car  (nth i pts)) px0)
   y1 (- (cadr (nth i pts)) py0)
   x2 (- (car  (nth (1+ i) pts)) px0)
   y2 (- (cadr (nth (1+ i) pts)) py0)
    )   
    (setq area (+ (- (* x1 y2)(* x2 y1)) area))
    (setq i (1+ i))
  )
  (abs (/ area 2))
)
  

461045462

楼主，试运行后，小数位结果都是3位。
3973.200平方米
32351.000米
如果觉得多了一位，修改小数后的位数设置就可以了

snddd2000

(setq fra_x (vl-string-left-trim "0" fra_x))
应该是 (setq fra_x (vl-string-right-trim "0" fra_x))
吧

cxs259

回复(setq fra_x (vl-string-left-trim "0" fra_x))
应该是 (setq fra_x (vl-string-right-trim "0" fra_x))
吧
还是不行

snddd2000

回复 cxs259 的帖子

两句都改了？

cxs259

都改了，你试了是不是可以啊!

461045462

回复 cxs259 的帖子

不知楼主是统一修改小数位吗，还是怎样？
如是，修改位数设置

cxs259

是程序有问题，统计出来的周长多了一位了

snddd2000

我试了下面积，LEFT和RIGHT，1平方米的时候没有区别都是1平方米，其他的值right出来的值不对，长度的时候left是对的出来1000.1米，right出来是10000.1米，没去看什么原因。

cxs259

上面程序是针对附图，出现统计周长时多一位数而言，如果在旁边再画一个矩形，所统计的周长面积是正确，这才会犯糊涂，究竟是程序有问题，还是附图有属性，或其它问题？