已经各点，求各点围成的面积？

shcvip

已经各点，求各点围成多变形的面积？
请教各位，程序如何编写？谢谢！

alexmai

搜一下，论坛有大量计算面积的lsp

yshf

(defun getptsarea(pts / osm pt mj)
    (vl-load-com)
    (setq osm (getvar "osmode"))
    (setvar "osmode" 0)
    (command "_pline")
    (foreach pt (command pt))
    (command "c")
    (setq obj (vlax-ename->vla-object (entlast)))
    (setq mj (vlax-get-property obj "Area"))
    (entdel (entlast))
    (setvar "osmode" osm)
    (setq mj mj)
)

cairunbin

楼主这帖子的质量，竟然也有人回复，哈哈。
楼主是有多忙，还是有多瞧不起技术。

lllllja

反而成了热帖？

hellomoshi

可以去论坛里面搜 有很多不同计算方法的程序

shcvip

cairunbin 发表于 2019-5-24 08:03
楼主这帖子的质量，竟然也有人回复，哈哈。
楼主是有多忙，还是有多瞧不起技术。

一个院长都回复的帖子。

shcvip

程序原地址：http://bbs.mjtd.com/forum.php?mo ... =%C8%A1%C3%E6%BB%FD

(defun c:dmj()
  (setvar "cmdecho" 0)
(setq cth (rtos (getvar "textsize")))
    (setq TextHeight (getdist (strcat "\n输入标注文字高度 < " cth " > : ")))
    (if (= TextHeight nil)(setq TextHeight cth))
(command "style" "tukou" "黑体" "0" "" "0" "" "")
(command "layer" "M" "面积单注" "C" "1" "" "LT" "CONTINUOUS" "" "");设置一个标注图层
  (defun maketext (txt pt)                ; 生成文字子函数
    (entmake (list '(0 . "TEXT")
                   (cons 62 3)
                   (cons 10 pt)
                   (cons 40 TextHeight)
                   (cons 1 txt)
                   '(41 . 0.6)
             )
    )
  )
  (setq pt (getpoint "\n选取点:"))
  (while pt
    (setvar "cecolor" "1")
    (command "bpoly" pt "")
    (setq en (entlast))
    (if (/= en nil)
      (progn
(command "area" "o" en)
(setq aa (getvar "area"))
(redraw en 3)
(setq bb (strcat "S=" (rtos aa 2 2 )"㎡"))
(setq pt1 (getpoint "请指定面积书写位置:"))
(command "_text" pt1 TextHeight "" bb 0)
)
      )
    (entdel en)
    (setvar "cecolor" "bylayer")
    (setq pt (getpoint "\n选取点:"))
   )
  (prin1)
  )