CAD统计多条线段长度程序及程序加载方法

(defun c:mulen()

   (setq i 1 s 0)

   (prompt "

选择直线：")

   (setq ss (ssget))

   (setq leng (sslength ss))

   (setq namelist (list(ssname ss 0)))

   (repeat (1- leng) (setq namelist (append namelist (list (ssname ss i)))) (setq i (1+ i)))

   (foreach name namelist 

      (setq nameall (entget name))

      (setq ps (cdr (assoc 10 nameall)))

      (setq pe (cdr (assoc 11 nameall)))

      (setq psx (car ps))

      (setq psy (cadr ps))

      (setq psz (caddr ps))

      (setq pex (car pe))

      (setq pey (cadr pe))

      (setq pez (caddr pe))

      (setq x (- psx pex))

      (setq y (- psy pey))   

      (setq z (- psz pez))

      (setq length (sqrt (+ (expt x 2) (expt y 2) (expt z 2))))

      (setq s (+ s length))

   )

   (princ (strcat "

直线总长为："(rtos s)))

   (princ)

){:em27}

上述为程序内容，然后存为：“文件名.lsp”，再从CAD里用appload命令加载此文件。

这里有一个程序，你可以用用看，

命令为AM

对line ,arc ,ellispe,spline,polyline,lwpolyline,circle,mline,solid均有效。

你既可统计长度，也可统计面积，或者两者都统计。

如果你对精确位不满意，你可以改动程序中的数字（我已经在程序注释中说明）。

;;;=================== 

;;;面积和长度统计程序 

;;;highflybird kunming 

;;;=================== 

(prompt "命令为:AM") 

(defun C:am (/ 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 4) "米"))    ;总长度为:小数后4位 

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

)