按线型统计长度

xx16451860 · 发表于 2012-9-2 12:24

本帖最后由 xx16451860 于 2012-9-3 13:04 编辑

按线型统计长度

龙山居士 · 发表于 2024-1-14 11:49

可以按颜色统计列表不

redoasis · 发表于 2017-9-18 23:20

不知能否在Mac上使用？

我一想起你就 · 发表于 2024-1-15 14:54

按图层。我搞了一个。

chpmould · 发表于 2012-9-2 16:13

这类程序论坛很多...

xx16451860 · 发表于 2012-9-2 18:54

chpmould 发表于 2012-9-2 16:13
这类程序论坛很多...

这个真没发现有！要不你贴一个？

夏生生 · 发表于 2012-9-2 21:30

实属胡编乱造，别当真啊，有bug别找我，因为我确实没啥用，练习来的

(DEFUN c:画图不规范才用 (/ SS EN
EIGENVALUE LAYER_LST LST
BYLAYER_LST NOTBYLAYER_LST
)
(defun x_ssn (ss / n lst)
(repeat (setq N (sslength ss))
(setq LST (cons (ssname SS (setq N (1- N))) LST))
)
)
(defun x_length_add (lst / x)
(apply
'+
(mapcar '(lambda (x)
(vlax-curve-getDistAtParam x (vlax-curve-getEndParam x))
)
lst
)
)
)
(defun get_layer_list (/ lay_name layer_list name)
(setq layer_list nil)
(while (setq name (tblnext "layer"))
(setq lay_name (cons (cdr (assoc 2 name)) (cdr (assoc 6 name))))
(setq layer_list (cons lay_name layer_list))
)
(tblnext "layer" t)
layer_list
)
(setq ss (ssget (list '(0 . "*line,arc,circle,ellipse"))))
(setq en (car (entsel "\n选取特征线型图元:")))
(if (setq Eigenvalue (cdr (assoc 6 (entget en))))
Eigenvalue
(setq Eigenvalue
(cdr (assoc
6
(entget
(tblobjname "layer" (cdr (assoc 8 (entget en))))
)
)
)
)
)
(setq layer_lst (vl-remove nil
(mapcar '(lambda (x)
(if (= Eigenvalue (cdr x))
(car x)
)
)
(get_layer_list)
)
)
)
(setq lst (x_ssn ss))
(setq bylayer_lst
(apply
'append
(vl-remove
nil
(mapcar
'(lambda (x)
(vl-remove nil
(mapcar '(lambda (y)
(if (= y (cdr (assoc 8 (entget x))))
x
)
)
layer_lst
)
)
)
lst
)
)
)
)
(setq notbylayer_lst
(vl-remove nil
(mapcar '(lambda (x)
(if (= Eigenvalue (cdr (assoc 6 (entget x))))
x
)
)
lst
)
)
)
(princ
(strcat
"\n线型为"
Eigenvalue
"的图元长度合计"
(rtos (+ (x_length_add bylayer_lst) (x_length_add notbylayer_lst))
2
2
)
"mm"
)
)
(princ)
)

(DEFUN c:画图不规范才用        (/              SS           EN 
                         EIGENVALUE   LAYER_LST           LST 
                         BYLAYER_LST  NOTBYLAYER_LST 
                        ) 
  (defun x_ssn (ss / n lst) 
    (repeat (setq N (sslength ss)) 
      (setq LST (cons (ssname SS (setq N (1- N))) LST)) 
    ) 
  ) 
  (defun x_length_add (lst / x) 
    (apply 
      '+ 
      (mapcar '(lambda (x) 
                 (vlax-curve-getDistAtParam x (vlax-curve-getEndParam x)) 
               ) 
              lst 
      ) 
    ) 
  ) 
  (defun get_layer_list        (/ lay_name layer_list name) 
    (setq layer_list nil) 
    (while (setq name (tblnext "layer")) 
      (setq lay_name (cons (cdr (assoc 2 name)) (cdr (assoc 6 name)))) 
      (setq layer_list (cons lay_name layer_list)) 
    ) 
    (tblnext "layer" t) 
    layer_list 
  ) 
  (setq ss (ssget (list '(0 . "*line,arc,circle,ellipse")))) 
  (setq en (car (entsel "\n选取特征线型图元:"))) 
  (if (setq Eigenvalue (cdr (assoc 6 (entget en)))) 
    Eigenvalue 
    (setq Eigenvalue 
           (cdr        (assoc 
                  6 
                  (entget 
                    (tblobjname "layer" (cdr (assoc 8 (entget en)))) 
                  ) 
                ) 
           ) 
    ) 
  ) 
  (setq        layer_lst (vl-remove nil 
                             (mapcar '(lambda (x) 
                                        (if (= Eigenvalue (cdr x)) 
                                          (car x) 
                                        ) 
                                      ) 
                                     (get_layer_list) 
                             ) 
                  ) 
  ) 
  (setq lst (x_ssn ss)) 
  (setq        bylayer_lst 
         (apply 
           'append 
           (vl-remove 
             nil 
             (mapcar 
               '(lambda        (x) 
                  (vl-remove nil 
                             (mapcar '(lambda (y) 
                                        (if (= y (cdr (assoc 8 (entget x)))) 
                                          x 
                                        ) 
                                      ) 
                                     layer_lst 
                             ) 
                  ) 
                ) 
               lst 
             ) 
           ) 
         ) 
  ) 
  (setq        notbylayer_lst 
         (vl-remove nil 
                    (mapcar '(lambda (x) 
                               (if (= Eigenvalue (cdr (assoc 6 (entget x)))) 
                                 x 
                               ) 
                             ) 
                            lst 
                    ) 
         ) 
  ) 
  (princ 
    (strcat 
      "\n线型为" 
      Eigenvalue 
      "的图元长度合计" 
      (rtos (+ (x_length_add bylayer_lst) (x_length_add notbylayer_lst)) 
            2 
            2 
      ) 
      "mm" 
    ) 
  ) 
  (princ) 
)

夏生生 · 发表于 2012-9-2 21:32

xx16451860 发表于 2012-9-2 18:54
这个真没发现有！要不你贴一个？

别介意，呵呵，玩笑

xx16451860 · 发表于 2012-9-2 22:04

夏生生发表于 2012-9-2 21:32
别介意，呵呵，玩笑

哎呀，没弄好就不要发出来吗！还是我的好用！

lizhiqiang9801 · 发表于 2013-6-20 09:06

楼主解释一下框选线段怎么选不上呢

lincctw_ccl · 发表于 2013-9-26 22:00

真的是不錯用~

li809 · 发表于 2017-9-19 17:00

过来支持一下。

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

按线型统计长度

本帖子中包含更多资源

点评

点评

点评