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

tudou119

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

tudou119

最好能批量处理的；

小也75

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

newer

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

去 每日插件 论坛找，有。

南宁-南子

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

南宁-南子

更正，少了一个（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)
)

阿阿锟

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

kmliro_2017

谢谢分享！！！！！！