线长分类统计数量及长度和总数量及总长(源)

NetBee · 发表于 2009-8-2 20:15

需要统计图中各种线长有用，如图

KO你 · 发表于 2022-9-13 23:26

zgssd 发表于 2009-9-23 13:49
本帖最后由作者于 2009-9-23 15:37:36 编辑用了5楼的源码，为何不能统计多段线长度？我做了如下修改， ...

怎样加上面域的线呢论坛找了很多线长与面积的，但就没有面域的。

Giuly09 · 发表于 2018-5-9 11:27

谢谢分享
程序不错

taoyi0727 · 发表于 2018-4-24 15:47

这个好用学习下

qyr_0_0 · 发表于 2009-9-9 11:28

错误: no function definition: NBTF_DXF----请问版主什么原因？

AMTONNY · 发表于 2009-9-9 12:53

楼主,请教如何在程序中过滤掉同心圆,只选取最大直径的圆呢?

zml84 · 发表于 2009-9-9 16:04

(DEFUN nbtf_dxf (I EN)
(CDR (ASSOC I (ENTGET EN)))
)

复制代码

zml84 · 发表于 2009-9-9 16:50

(vl-load-com)
(defun C:SUMLEN (/)
(setq LST '(("LINE" "直线")
("ARC" "圆弧")
("CIRCLE" "圆")
("LPOLYLINE" "多段线")
("ELLIPSE" "椭圆")
("SPLINE" "样条线")
)
)
(if (setq SS (ssget '((0 . "LINE,ARC,CIRCLE,LPOLYLINE,ELLIPSE,SPLINE"))
)
)
(progn
;;1.逐个统计
(setq I 0)
(repeat (sslength SS)
(setq EN (ssname SS I)
ENT (entget EN)
STR (cdr (assoc 0 ENT))
)
(if (setq TMP (assoc STR LST))
(setq LEN (vlax-curve-getdistatparam
EN
(vlax-curve-getendparam EN)
)
LST (subst (append TMP (list LEN)) TMP LST)
)
)
(setq I (1+ I))
)
;;2.显示
(setq PRTXT
"线条长度分类统计\n\n类型\t根数\t长度\n----------------------"
)
(foreach N LST
(if (> (length N) 2)
(setq LEN (apply '+ (cddr N))
PRTXT (strcat PRTXT
"\n"
(cadr N)
"\t"
(itoa (- (length N) 2))
"\t"
(rtos LEN 2 3)
)
)
)
)
(setq
PRTXT
(strcat
PRTXT
"\n\n总数:"
(itoa (- (length (apply 'append LST))
(* 2 (length LST))
)
)
" 总长度:"
(rtos (apply '+
(apply 'append (mapcar 'cddr LST))
)
2
3
)
)
)
(princ PRTXT)
(alert PRTXT)
)
)
(princ)
)

(vl-load-com)
(defun C:SUMLEN (/)
    (setq LST '(("LINE" "直线")
  ("ARC" "圆弧")
  ("CIRCLE" "圆")
  ("LPOLYLINE" "多段线")
  ("ELLIPSE" "椭圆")
  ("SPLINE" "样条线")
        )
    )
    (if (setq SS (ssget '((0 . "LINE,ARC,CIRCLE,LPOLYLINE,ELLIPSE,SPLINE"))
   )
 )
 (progn
     ;;1.逐个统计
     (setq I 0)
     (repeat (sslength SS)
  (setq EN  (ssname SS I)
        ENT (entget EN)
        STR (cdr (assoc 0 ENT))
  )
  (if (setq TMP (assoc STR LST))
      (setq LEN (vlax-curve-getdistatparam
      EN
      (vlax-curve-getendparam EN)
         )
     LST (subst (append TMP (list LEN)) TMP LST)
      )
  )
  (setq I (1+ I))
     )
     ;;2.显示
     (setq PRTXT
       "线条长度分类统计\n\n类型\t根数\t长度\n----------------------"
     )
     (foreach N LST
  (if (> (length N) 2)
      (setq LEN (apply '+ (cddr N))
     PRTXT (strcat PRTXT
     "\n"
     (cadr N)
     "\t"
     (itoa (- (length N) 2))
     "\t"
     (rtos LEN 2 3)
    )
      )
  )
     )
     (setq
  PRTXT
     (strcat
         PRTXT
         "\n\n总数:"
         (itoa (- (length (apply 'append LST))
    (* 2 (length LST))
        )
         )
         "  总长度:"
         (rtos (apply '+
        (apply 'append (mapcar 'cddr LST))
        )
        2
        3
         )
     )
     )
     (princ PRTXT)
     (alert PRTXT)
 )
    )
    (princ)
)

asdfxx · 发表于 2009-9-11 17:33

提示: 作者被禁止或删除内容自动屏蔽

zgssd · 发表于 2009-9-23 13:49

本帖最后由作者于 2009-9-23 15:37:36 编辑

用了5楼的源码，为何不能统计多段线长度？我做了如下修改，不知对否

(vl-load-com)
(defun C:SUMLEN (/)
     (setq LST '(("LINE" "直线")
   ("ARC" "圆弧")
   ("CIRCLE" "圆")
   ("LWPOLYLINE" "多段线")
   ("ELLIPSE" "椭圆")
   ("SPLINE" "样条线")
         )
     )
     (if (setq SS (ssget '((0 . "LINE,ARC,CIRCLE,LWPOLYLINE,ELLIPSE,SPLINE"))
    )
)
(progn
      ;;1.逐个统计
      (setq I 0)
      (repeat (sslength SS)
   (setq EN (ssname SS I)
         ENT (entget EN)
         STR (cdr (assoc 0 ENT))
   )
   (if (setq TMP (assoc STR LST))
       (setq LEN (vlax-curve-getdistatparam
       EN
       (vlax-curve-getendparam EN)
          )
      LST (subst (append TMP (list LEN)) TMP LST)
       )
   )
   (setq I (1+ I))
      )
      ;;2.显示
      (setq PRTXT
        "线条长度分类统计\n\n类型\t根数\t长度\n----------------------"
      )
      (foreach N LST
   (if (> (length N) 2)
       (setq LEN (apply '+ (cddr N))
      PRTXT (strcat PRTXT
      "\n"
      (cadr N)
      "\t"
      (itoa (- (length N) 2))
      "\t"
      (rtos LEN 2 3)
     )
       )
   )
      )
      (setq
   PRTXT
      (strcat
          PRTXT
          "\n\n总数:"
          (itoa (- (length (apply 'append LST))
     (* 2 (length LST))
         )
          )
          " 总长度:"
          (rtos (apply '+
         (apply 'append (mapcar 'cddr LST))
         )
         2
         3
          )
      )
      )
      (princ PRTXT)
      (alert PRTXT)
)
     )
     (princ)
)

追风 · 发表于 2010-1-27 12:20

好东东，下载了，谢谢分享！

lianheai · 发表于 2010-2-8 16:08

很受用啊，谢谢了

xotoo · 发表于 2011-2-26 17:17

留名备用
程序不错

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

线长分类统计数量及长度和总数量及总长(源)

本帖子中包含更多资源

本帖被以下淘专辑推荐:

学习1楼代码，修改后

浏览过的版块

asdfxx asdfxx 当前离线积分 2242 明经币个注册时间 2009-7-22 在线时间小时威望金钱个贡献激情	发表于 2009-9-11 17:33 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽

	回复支持反对使用道具举报显身卡