香田里浪人 发表于 2013-1-13 13:55:00

闭合多义线面积批量标注

(defun c:mjjs (/ ss j length1 m ent zbc i sum x y n2 cx cy x1 x2 p1 p3 p4 pt area)
   (setvar "cmdecho" 0)
(setq ss (ssget "x" (list (cons 0 "lwpolyline")))
length1 (- (sslength ss) 1)
j0
)
(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 (listx(+ y 0.3))
               p4 (listx(- 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)
   
   
)
)

清风明月名字 发表于 2013-8-27 14:31:10

谢谢楼主的分享，试用了，非常好，收藏备用了！

半夜星星 发表于 2018-2-2 15:29:02

楼主的插件有问题的，后面的楼的代码是对的，

长风（尚品） 发表于 2013-1-13 16:05:12

命令: mjjs ; 错误: 参数类型错误: lselsetp nil   花了币确不能用，楼主不是坑人吗？还我币来

香田里浪人 发表于 2013-1-13 16:08:51

成果字体很小，请楼上看清楚再说。不然把最后一行字体改大。

yoyoho 发表于 2013-1-13 17:37:43

指令: MJJS
; 错误: no function definition: MKLA

香田里浪人 发表于 2013-1-13 18:00:54

我在2004中确实能运行，不知你们cad版本。我也没有收钱，哪来坑人吗？

xiabin68 发表于 2013-1-13 21:01:56

zyhandw 发表于 2013-1-14 16:26:11

程序这么长啊，是不是还有更简单的写法

香田里浪人 发表于 2013-1-17 13:42:59

zyhandw 发表于 2013-1-14 16:26 static/image/common/back.gif
程序这么长啊，是不是还有更简单的写法

愿望是良好的，可是目前还没有更好的办法。

tianyi1230 发表于 2013-3-8 17:47:48

程序很好使用，就是单位不对，不知道是什么原因

潇湘飞雨 发表于 2013-3-9 17:16:40

正需要呢感恩。！！
页: [1] 2 3 4
查看完整版本: 闭合多义线面积批量标注