多条多段线构成的封闭曲线的面积

Kllies · 发表于 2017-3-6 20:56:47

本帖最后由 Kllies 于 2017-3-7 10:16 编辑

两条或两条以上的多段线构成的闭合的区域的面积（能选择标注亩/平方米/公顷），谢谢。

Lispboy · 发表于 2017-3-6 20:56:48

不只适合多段线，LINE,ARC,ELLIPSE,*POLYLINE

(defun c:tt ()
(defun _callback (dynpt)
(xdrx_setpropertyvalue ml "lastvertex" dynpt)
)
(defun _dimmake ()
(xd::text:init 1)
(xd::dim:init)
(if (not (setq blk (xdrx_object_get "block" "_dot")))
(setq blk (xdrx_document_makeablock "_dot"))
)
(setq ml (xdrx_mleader_make
p
p
(strcat "S="
(rtos #area
2
(getvar "dimdec")
)
d
)
(* 3.5
(xd::var:getratio)
)
)
)
(setq scl (xd::var:getratio))
(xdrx_setpropertyvalue
ml
"dogleglength"
(* 2 scl)
"scale"
(xd::var:getscaleratio)
"landinggap"
(* 2 scl)
"arrowsize"
(* 1.5 scl)
"ArrowSymbolId"
blk
)
(xdrx_pointmonitor "_callback")
(getpoint)
(xdrx_pointmonitor)
)
(xd::doc:checkversion '> "17.0" "")
(xdrx_begin)
(xdrx_initget "P G M")
(initget "P G M")
(if (not
(setq ge (getkword "\n单位格式[平方米(P)/公顷(G)/亩(M)]<亩>:"))
)
(setq ge "M")
)
(if
(and (setq p (getpoint "\n拾取封闭区域内一点<退出>:"))
(setq
ss (xdrx_geom_bpoly
p
'((0 . "*POLYLINE,LINE,ARC,ELLIPSE,ARC,CIRCLE"))
)
)
)
(progn
(if (xdrx_getpropertyvalue (entlast) "area")
(progn
(xdrx_entity_delete (entlast))
(cond
((= ge "M")
(setq #area (/ #area 666.666667)
d "亩"
)
)
((= ge "P")
(setq d "平")
)
((= ge "G")
(setq #area (/ #area 10000.0)
d "公顷"
)
)
)
(_dimmake)
)
)
)
)
(xdrx_end)
(princ)
)

(defun c:tt () 
  (defun _callback (dynpt) 
    (xdrx_setpropertyvalue ml "lastvertex" dynpt) 
  ) 
  (defun _dimmake () 
    (xd::text:init 1) 
    (xd::dim:init) 
    (if (not (setq blk (xdrx_object_get "block" "_dot"))) 
      (setq blk (xdrx_document_makeablock "_dot")) 
    ) 
    (setq ml (xdrx_mleader_make 
               p 
               p 
               (strcat "S=" 
                       (rtos #area 
                             2 
                             (getvar "dimdec") 
                       ) 
                       d 
               ) 
               (* 3.5 
                  (xd::var:getratio) 
               ) 
             ) 
    ) 
    (setq scl (xd::var:getratio)) 
    (xdrx_setpropertyvalue 
      ml 
      "dogleglength" 
      (* 2 scl) 
      "scale" 
      (xd::var:getscaleratio) 
      "landinggap" 
      (* 2 scl) 
      "arrowsize" 
      (* 1.5 scl) 
      "ArrowSymbolId" 
      blk 
    ) 
    (xdrx_pointmonitor "_callback") 
    (getpoint) 
    (xdrx_pointmonitor) 
  ) 
  (xd::doc:checkversion '> "17.0" "") 
  (xdrx_begin) 
  (xdrx_initget "P G M") 
  (initget "P G M") 
  (if (not 
        (setq ge (getkword "\n单位格式[平方米(P)/公顷(G)/亩(M)]<亩>:")) 
      ) 
    (setq ge "M") 
  ) 
  (if 
    (and (setq p (getpoint "\n拾取封闭区域内一点<退出>:")) 
         (setq 
           ss (xdrx_geom_bpoly 
                p 
                '((0 . "*POLYLINE,LINE,ARC,ELLIPSE,ARC,CIRCLE")) 
              ) 
         ) 
    ) 
     (progn 
       (if (xdrx_getpropertyvalue (entlast) "area") 
         (progn 
           (xdrx_entity_delete (entlast)) 
           (cond 
             ((= ge "M") 
              (setq #area (/ #area 666.666667) 
                    d     "亩" 
              ) 
             ) 
             ((= ge "P") 
              (setq d "平") 
             ) 
             ((= ge "G") 
              (setq #area (/ #area 10000.0) 
                    d     "公顷" 
              ) 
             ) 
           ) 
           (_dimmake) 
         ) 
       ) 
     ) 
  ) 
  (xdrx_end) 
  (princ) 
)

newer · 发表于 2017-3-6 21:07:42

画个图贴上来吧，如果有多种情况都画下。

Lispboy · 发表于 2017-3-6 21:57:30

楼主，这种画图习惯可不好，你的图中，为什么不把他们处理成一条封闭的多段线，也方便日后的编辑。

Kllies · 发表于 2017-3-6 22:13:45

Lispboy 发表于 2017-3-6 21:55

请问一下要保留到小数后两位该改哪里呢。

Kllies · 发表于 2017-3-6 22:16:29

Lispboy 发表于 2017-3-6 21:57

有时候从别人手里拿到的图就是这种样子的。不过我自己也有这种坏习惯。

newer · 发表于 2017-3-6 22:24:52

Kllies 发表于 2017-3-6 22:16

自己改系统变量

(getvar "dimdec")

程序是读的dimdec的设置

另外，如果解决了你的问题，编辑下主题帖，前面加上【已解决】吧。并且把你悬赏的D豆给LISPBOY

Kllies · 发表于 2017-3-6 22:30:10

newer 发表于 2017-3-6 22:24

好的，谢谢。

yoyoho · 发表于 2017-3-7 07:08:26

啥也不说了，感谢楼主分享哇！

xoyo88 · 发表于 2019-5-6 23:57:25

多条多段线构成的封闭曲线的面积

azyg125 · 发表于 2019-5-16 22:56:09

(defun c:tt()
 (setvar "cmdecho" 0)
 (initget 7)
 (setq n (getint "\n选择输出的单位<1亩/2平方米/3公顷>:"))
 (while (> n 3) (alert "输入有误") (setq n (getint "\n选择输出的单位<1亩/2平方米/3公顷>:")))
 (setq hz (getdist "\n输入字高<2>"))
 (if hz nil (setq hz 2))
 (setq p1 (getpoint "\n选择内部点"))
 (while p1
 (command "_BOUNDARY" p1 "")
 (command "_area" "o" (setq en (entlast)))
 (setq area (getvar "area"))
 (cond ((= n 1)(setq area1 (rtos (/ area 0.5 3 1000) 2 2) txt (strcat area1 "亩")))
 ((= n 2)(setq area1 (rtos area 2 2) txt (strcat area1 "平方米")))
 ((= n 3)(setq area1 (rtos (/ area 10000) 2 2) txt (strcat area1 "公顷")))
)
 (command "text" "non"p1 hz 0 txt)
(command "_erase" en "")
(setq p1 (getpoint "\n选择内部点")))
 (princ)
 )

账号		自动登录	找回密码
密码			立即注册

[已解决] 多条多段线构成的封闭曲线的面积

最佳答案