求解计算封闭路线的面积并注计在其形心

香田里浪人

;;修改图可直接改变面积，nwebuser原创 香田里浪人修改
(vl-load-com)
(defun c:mj (/)
(command "layer" "M" "面积标注" "C" "6" "" "LT" "CONTINUOUS" "" "");设置一个标注图层
(setvar"dimzin"0);;保留小数位数时如果位数不足可以补零
   (setq TextHeight (getdist "\n请输入文字高度:(默认1)"))
    (if (= TextHeight nil) (setq TextHeight 1))
  (setq e (car (entsel "\n 请选择多边形>>  ")))
  (setq e_obj (vlax-ename->vla-object e))
  (vla-getboundingbox e_obj 'minpt 'maxpt)
  (setq p1 (vlax-safearray->list minpt))
  (setq p2 (vlax-safearray->list maxpt))
  (setq mid (mapcar '(lambda (x y) (/ (+ x y) 2.)) p1 p2));;求两点中点
  (setq mj (strcat "S="(rtos (vla-get-area e_obj) 2 2)"㎡"))
  (entmake
    (list '(0 . "TEXT")
    (cons 7 "BG_ST")
    (cons 1 mj)
    (cons 10 mid)
    (cons 40 TextHeight)
    (cons 41 0.7)
    )
  )
  (setq wjb (cdr (assoc 5 (entget (entlast)))))
  (setq wjl (list wjb))
  (setq objlt (list e_obj))  ;图元名转换为VLA对象
  (setq  vrl (vlr-pers
        (vlr-object-reactor objlt wjl '((:vlr-modified . c-2l)))
      )
  )
  (princ)        ;静默退出
)
(defun c-2l (notifier-object
       reactor-object
       parameter-list
       /
      )
  (setq mj (strcat "S="(rtos (vla-get-area notifier-object) 2 2)"㎡"))
  (vla-getboundingbox notifier-object 'minpt 'maxpt)
  (setq p1 (vlax-safearray->list minpt))
  (setq p2 (vlax-safearray->list maxpt))
  (setq mid (mapcar '(lambda (x y) (/ (+ x y) 2.)) p1 p2)) ;;求两点中点
  (setq we (handent (car (vlr-data reactor-object)))) ;获取文本图元名
  (setq wel (entget we))
  (setq wel (subst (vl-list* 10 mid) (assoc 10 wel) wel))
  (setq wel (subst (vl-list* 1 mj) (assoc 1 wel) wel))
  (setq
    wel  (subst (vl-list* 40 TextHeight)
         (assoc 40 wel)
         wel
  )
  )
  (entmod wel)        ;更新文本图元表
)