论坛 › CAD与数据库编程 › 封闭区域自动标注面积、长度

tudou119 发表于 2014-6-6 00:11:39

封闭区域自动标注面积、长度

求CAD图形中自动标注面积、周长的程序，谢谢大侠

tudou119 发表于 2014-6-6 00:13:40

最好能批量处理的；

小也75 发表于 2016-8-27 21:11:43

程序在哪啊？没看到？？？？？？？

newer 发表于 2016-8-27 21:38:18

小也75 发表于 2016-8-27 21:11
程序在哪啊？没看到？？？？？？？

去 每日插件 论坛找，有。

南宁-南子 发表于 2017-9-5 17:14:56

(defun c:SignAreaLength (/ AREA CEN ENT HEIGTHSTR I LEN PTNUM PTS SS STR WIDTHSTR)
(setq ss (ssget '((0 . "lwpolyline") (70 . 1))))
(setq i 0)
(repeat (sslength ss)
;;;    计算所需参数
    (setq ent          (ssname ss i)        ;多边形
          ptnum          (cdr (assoc 90 (entget ent))) ;顶点数
          area          (vlax-curve-getarea ent) ;面积
          len          (vlax-curve-getDistAtParam ent ptnum) ;周长
          pts          (mapcar 'cdr
                          (vl-remove-if-not
                              '(lambda (x)
                               (if (= 10 (car x))
                                   t
                                   nil
                               )
                             )
                              (entget ent)
                          )
                  )                        ;多边形定点集合
          cen          (list (/ (apply '+ (mapcar 'car pts)) ptnum)
                          (/ (apply '+ (mapcar 'cadr pts)) ptnum)
                          0.0
                  )                        ;多边形中心
          str          (strcat "面积:" (rtos area 2 2) "\n周长:" (rtos len 2 2))
                                        ;插入文字内容
          heigthstr (* (getvar "VIEWSIZE") 0.05)
                                        ;以绘图区域高度的5%为字高
          widthstr(* heigthstr (strlen str))
                                        ;文字高度*文字长度=文字宽度
    )

;;;    在图上注记文字
    (vla-put-height
      (vla-addmtext
        (vla-get-modelspace
          (vla-get-activedocument (vlax-get-acad-object))
        )
        (vlax-safearray-fill
          (vlax-make-safearray vlax-vbdouble '(0 . 2))
          cen
        )                                ;文字插入点
        widthstr
        str
      )
      heigthstr
    )
)
(princ)
)

南宁-南子 发表于 2017-9-5 17:18:49

更正，少了一个（setq （1+ i)）

(defun c:SignAreaLength (/ AREA CEN ENT HEIGTHSTR I LEN PTNUM PTS SS STR WIDTHSTR)
(setq ss (ssget '((0 . "lwpolyline") (70 . 1))))
(setq i 0)
(repeat (sslength ss)
;;;    计算所需参数
    (setq ent          (ssname ss i)        ;多边形
          ptnum          (cdr (assoc 90 (entget ent))) ;顶点数
          area          (vlax-curve-getarea ent) ;面积
          len          (vlax-curve-getDistAtParam ent ptnum) ;周长
          pts          (mapcar 'cdr
                          (vl-remove-if-not
                              '(lambda (x)
                               (if (= 10 (car x))
                                   t
                                   nil
                               )
                             )
                              (entget ent)
                          )
                  )                        ;多边形定点集合
          cen          (list (/ (apply '+ (mapcar 'car pts)) ptnum)
                          (/ (apply '+ (mapcar 'cadr pts)) ptnum)
                          0.0
                  )                        ;多边形中心
          str          (strcat "面积:" (rtos area 2 2) "\n周长:" (rtos len 2 2))
                                        ;插入文字内容
          heigthstr (* (getvar "VIEWSIZE") 0.05)
                                        ;以绘图区域高度的5%为字高
          widthstr(* heigthstr (strlen str))
                                        ;文字高度*文字长度=文字宽度
    )

;;;    在图上注记文字
    (vla-put-height
      (vla-addmtext
        (vla-get-modelspace
          (vla-get-activedocument (vlax-get-acad-object))
        )
        (vlax-safearray-fill
          (vlax-make-safearray vlax-vbdouble '(0 . 2))
          cen
        )                                ;文字插入点
        widthstr
        str
      )
      heigthstr
    )
    (setq i (1+ i))
)
(princ)
)

阿阿锟 发表于 2019-10-28 16:31:00

@南宁-南子，要能编写出这样的语言要从什么基础学起

kmliro_2017 发表于 2023-7-16 08:19:16

谢谢分享！！！！！！

查看完整版本: 封闭区域自动标注面积、长度