框选所有所有闭合的图形标面积

--@----- · 发表于 2013-11-22 20:39:50

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

如下图所示。框选所有的闭合多段线（弧形也可以），自动在每个闭合的图形中心标出面积来。有2点要求，1：最好设置可选择的保留几位数。2：标出来的面积居图形中心处。3：面积带不带㎡单位，无所谓,最好别带上{:soso_e113:}

eachy · 发表于 2013-11-22 21:00:20

这个论坛上搜索很多个，这个中心对凸形 Ok，凹形就不一定了

newer · 发表于 2013-11-22 21:08:28

也不是要参与数学运算，何必要求多边形的中心，包围盒的中心就行了。

--@----- · 发表于 2013-11-22 21:20:23

newer 发表于 2013-11-22 21:08
也不是要参与数学运算，何必要求多边形的中心，包围盒的中心就行了。

嗯那也行，主要是怕数字跑远了

st788796 · 发表于 2013-11-22 21:52:52

--@----- 发表于 2013-11-22 21:20
嗯那也行，主要是怕数字跑远了

(defun c:tt (/ ss)
(if (setq ss (ssget '((0 . "circle,*polyline,ellipse,spline"))))
(mapcar
'(lambda (x / txt)
(and (xdrx_curve_isclosed x)
(setq
txt (xdrx_text_make
(apply 'xdrx_points_centroid (xdrx_entity_box x))
(rtos (car (xdrx_getarea x)) 2 3)
3.5 ;_text height
0.
)
)
(xdrx_text_setvermode txt 2)
(xdrx_text_sethozmode txt 1)
)
)
(xdrx_pickset->ents ss)
)
)
(princ)
)

Free-Lancer · 发表于 2013-11-23 08:38:45

vla 方法

(defun c:tt ()
(fy:clearcset)
(if (ssget '((0 . "circle,*polyline,ellipse,spline")))
(mapcar
'(lambda (x / bp up)
(and (vlax-curve-isclosed x)
(vla-getboundingbox x 'bp 'up)
(vla-addtext
(fy:acms)
(rtos (vlax-curve-getarea x) 2 3)
(vlax-3d-point
(trans
(mapcar
'*
'(0.5 0.5 0.5)
(mapcar '+
(safearray-value bp)
(safearray-value up)
)
)
1
0
)
)
3.5
)
)
)
(fy:cset->objs)
)
)
(princ)
)

(defun c:tt () 
  (fy:clearcset) 
  (if (ssget '((0 . "circle,*polyline,ellipse,spline"))) 
    (mapcar 
      '(lambda (x / bp up) 
         (and (vlax-curve-isclosed x) 
              (vla-getboundingbox x 'bp 'up) 
              (vla-addtext 
                (fy:acms) 
                (rtos (vlax-curve-getarea x) 2 3) 
                (vlax-3d-point 
                  (trans 
                    (mapcar 
                      '* 
                      '(0.5 0.5 0.5) 
                      (mapcar '+ 
                              (safearray-value bp) 
                              (safearray-value up) 
                      ) 
                    ) 
                    1 
                    0 
                  ) 
                ) 
                3.5 
              ) 
         ) 
       ) 
      (fy:cset->objs) 
    ) 
  ) 
  (princ) 
)

--@----- · 发表于 2013-11-23 10:27:25

st788796 发表于 2013-11-22 21:52

不能设置保留几位数，文字高度太小，默认500/1000的字高会好些

st788796 · 发表于 2013-11-23 10:34:44

--@----- 发表于 2013-11-23 10:27
不能设置保留几位数，文字高度太小，默认500/1000的字高会好些

字高根据自己绘图情况修改，保留几位修改 rtos

QiaoCheng · 发表于 2013-11-23 14:09:21

st788796 发表于 2013-11-23 10:34
字高根据自己绘图情况修改，保留几位修改 rtos

凑合凑合用,里面的xdrx函数不知道是不是这样的{:soso_e113:}

(defun c:tt ( / ss txt x zg)
(vl-load-com)
(setq zg (getreal "\n请输入字体高度<10>:"))
(if (= nil zg) (setq zg 10.0))
(if (setq ss (ssget '((0 . "circle,*polyline,ellipse,spline"))))
(mapcar
'(lambda (x / txt)
(if (xdrx_curve_isclosed x)
(setq txt
(xdrx_text_make
(xdrx_points_centroid x)
(rtos (vlax-curve-getArea (vlax-ename->vla-object x)) 2 3)
zg
0.
1.0
1
0
)
)
)
)
(xdrx_pickset->ents ss)
)
)
(princ)
)
(defun xdrx_pickset->ents (ss / i s)
(if ss
(repeat (setq i (sslength ss))
(setq s (cons (ssname ss (setq i (1- i))) s))
)
)
)
(defun xdrx_curve_isclosed (e)
(= 1 (logand (cdr (assoc 70 (entget e))) 1))
)
(defun xdrx_points_centroid (poly / pl ms va reg cen)
(setq pl (vlax-ename->vla-object poly)
ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
va (vlax-make-safearray vlax-vbObject '(0 . 0))
)
(vlax-safearray-put-element va 0 pl)
(setq reg (car (vlax-safearray->list (vlax-variant-value (vla-Addregion ms va))))
cen (vla-get-Centroid reg)
)
(vla-Delete reg)
(vlax-safearray->list (vlax-variant-value cen))
)
(defun xdrx_text_make (pt str h r w y x)
(entmake
(list
'(0 . "TEXT") (cons 10 pt) (cons 1 str) (cons 40 h) (cons 50 r) (cons 41 w)
(cons 72 y) (cons 73 x) (cons 11 pt) '(71 . 0)
)
)
)

(defun c:tt ( / ss txt x zg) 
  (vl-load-com) 
  (setq zg (getreal "\n请输入字体高度<10>:")) 
  (if (= nil zg) (setq zg 10.0)) 
  (if (setq ss (ssget '((0 . "circle,*polyline,ellipse,spline")))) 
    (mapcar 
      '(lambda (x / txt) 
        (if (xdrx_curve_isclosed x) 
          (setq txt 
             (xdrx_text_make 
               (xdrx_points_centroid x) 
               (rtos (vlax-curve-getArea (vlax-ename->vla-object x)) 2 3) 
               zg 
               0. 
               1.0 
               1 
               0 
             ) 
          ) 
        ) 
      ) 
      (xdrx_pickset->ents ss) 
    ) 
  ) 
  (princ) 
) 
(defun xdrx_pickset->ents (ss / i s) 
  (if ss 
    (repeat (setq i (sslength ss)) 
      (setq s (cons (ssname ss (setq i (1- i))) s)) 
    ) 
  ) 
) 
(defun xdrx_curve_isclosed (e) 
  (= 1 (logand (cdr (assoc 70 (entget e))) 1)) 
) 
(defun xdrx_points_centroid (poly / pl ms va reg cen) 
  (setq pl (vlax-ename->vla-object poly) 
        ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) 
        va (vlax-make-safearray vlax-vbObject '(0 . 0)) 
  ) 
  (vlax-safearray-put-element va 0 pl) 
  (setq reg (car (vlax-safearray->list (vlax-variant-value (vla-Addregion ms va)))) 
        cen (vla-get-Centroid reg) 
  ) 
  (vla-Delete reg) 
  (vlax-safearray->list (vlax-variant-value cen)) 
) 
(defun xdrx_text_make (pt str h r w y x) 
  (entmake 
    (list 
      '(0 . "TEXT") (cons 10 pt) (cons 1 str) (cons 40 h) (cons 50 r) (cons 41 w) 
      (cons 72 y) (cons 73 x) (cons 11 pt) '(71 . 0) 
    ) 
  ) 
)

newer · 发表于 2013-11-23 14:12:22

本帖最后由 newer 于 2013-11-23 14:14 编辑

QiaoCheng 发表于 2013-11-23 14:09
凑合凑合用,里面的xdrx函数不知道是不是这样的

程序没调试，只说明下，用XDRX_API就不要用VLA对象了，这样就复杂了。

(rtos (vlax-curve-getArea (vlax-ename->vla-object x)) 2 3)

可以改为：

(rtos (xdrx_getpropertyvalue x "Area") 2 3)

看你下面的代码，难道你在用LISP模拟写API函数吗？你用的函数 API都有。

xdrx_pickset->ents
xdrx_curve_isclosed
......

--@----- · 发表于 2013-11-23 15:23:28

本帖最后由 --@----- 于 2013-11-23 15:37 编辑

QiaoCheng 发表于 2013-11-23 14:09
凑合凑合用,里面的xdrx函数不知道是不是这样的

希望优化如下功能，1：字高默认值，不设置的时候就是默认值，以及保留几位数，都是默认的。当然也是可以设置的。默认就让空格代替掉，或者增加个命令参数来设置字高以及保留几位数(最好是默认上次设置的，而不是一个固定值，每次去改）: 2：计算出来的是平方米为单位的而不是平方毫米呵呵单位可以不用带上的

st788796 · 发表于 2013-11-23 16:16:03

--@----- 发表于 2013-11-23 15:23
希望优化如下功能，1：字高默认值，不设置的时候就是默认值，以及保留几位数，都是默认的。当然也是可 ...

这点小改动难不倒楼主吧！

sachindkini · 发表于 2013-11-23 16:39:42

Free-Lancer 发表于 2013-11-23 08:38
vla 方法

dear sir,

error

Command: tt ; error: no function definition: FY:CLEARCSET

复制代码

Free-Lancer · 发表于 2013-11-24 12:03:16

sachindkini 发表于 2013-11-23 16:39
dear sir,

error

http://bbs.xdcad.net/forum.php?m ... p;extra=#pid3497493

sachindkini · 发表于 2013-11-25 13:29:31

Free-Lancer 发表于 2013-11-24 12:03
http://bbs.xdcad.net/forum.php?mod=viewthread&tid=671794&page=1&extra=#pid3497493

dear sir,

thxxx

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

[求助] 框选所有所有闭合的图形标面积

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评

点评

点评

点评

点评

点评