“计算所有封闭区域面积”如何将各个封闭区面积导入到excel

香田里浪人

有高手编写的“封闭区域面积”原程序如下，该程序只能将面积写在图上，不能导入到excel，如何将各个封闭区面积导入到excel
(defun c:mjjs (/ ss j length1 m ent zbc i sum x y n2 cx cy x1 x2 p1 p3 p4 pt area)
defun maketext (txt pt)             ; 生成文字子函数
    (entmake (list '(0 . "TEXT") (cons 62 1) (cons 10 pt) (cons 40 TextHeight) (cons 1 txt) '(41 . 0.8)'(7 . "BG_ST")))
  )  
(setvar "cmdecho" 0)
  (setq ss (ssget "x" (list (cons 0 "lwpolyline")))
length1 (- (sslength ss) 1)
j  0
  )
  (while (>= length1 0)
    (setq m   (ssname ss length1)
   ent (entget m)
   zbc '()
   i   1
   sum 0
   x   0
   y   0
     
    )
    (foreach n1 ent
      (if (= (nth 0 n1) 10)
(setq zbc (cons (cdr n1) zbc))
      )
    )
    (foreach n2 zbc
      (if (/= (rem i 2) 0)
(progn
   (setq x1 (nth 0 n2)
  y1 (nth 1 n2)
  i  (+ i 1)
   )
   (if (>= i 3)
     (progn
       (setq area (* (- (* x2 y1) (* x1 y2)) 0.500)
      sum  (+ sum area)
      cx (* (- (* x2 y1) (* x1 y2)) (+ x2 x1))
             cy   (* (- (* x2 y1) (* x1 y2)) (+ y1 y2))
      x (+ x cx)
      y (+ y cy)
       )
     )
   )
)
(progn
   (setq x2   (nth 0 n2)
  y2   (nth 1 n2)
  area (* (- (* x1 y2) (* x2 y1)) 0.500)
  sum  (+ sum area)
  cx   (* (- (* x1 y2) (* x2 y1)) (+ x2 x1))
  cy   (* (- (* x1 y2) (* x2 y1)) (+ y1 y2))
  i    (+ i 1)
  x    (+ x cx)
  y    (+ y cy)
   )

)
      )
    )
    (if (= (rem i 2) 0)
      (setq p1  (nth 0 zbc)
     x2  (nth 0 p1)
     y2  (nth 1 p1)
     area (* (- (* x1 y2) (* x2 y1)) 0.5)
     sum  (+ sum area)
     cx  (* (- (* x1 y2) (* x2 y1)) (+ x2 x1))
     cy  (* (- (* x1 y2) (* x2 y1)) (+ y1 y2))
     x  (+ x cx)
     y  (+ y cy)
      )
      (setq p1  (nth 0 zbc)
     x1  (nth 0 p1)
     y1  (nth 1 p1)
     area (* (- (* x2 y1) (* x1 y2)) 0.5);;;此句确定面积标注字体大小
     sum  (+ sum area)
     cx  (* (- (* x2 y1) (* x1 y2)) (+ x2 x1))
     cy  (* (- (* x2 y1) (* x1 y2)) (+ y1 y2))
     x  (+ x cx)
     y  (+ y cy)
      )
    )
    (setq x  (/ x (* sum 6))
   y  (/ y (* sum 6))
   pt (list  (- x 0.8) y)
          p1 (list  (+ x 0.8)  y)
    )
    (setq sum   (rtos (abs sum) 2 2)

   length1 (- length1 1)
                 p3 (list  x  (+ y 0.3))
                 p4 (list  (- X 1.9)  (+ y 0.3))
                 j (+ j 1)
               
    )
(setq sum (strcat "S=" sum  "㎡"))
(mkla "面积注释" 1);;;此句可以显示面积标注颜色，1红色2黄色3绿色
    (command "text" "j" "m" p3 0.5 0 sum)
(command "text" "j" "m" p4 0.5 0 (rtos j 2 0))
   
  )
)
谢谢！

cuyongping

很实用顶起来！呵呵

革天明

自己搜索一下，太多了这个功能，论坛多几个帖子了