求不同图层，不同文字个数，并输出excel

四啤酒瓶 · 发表于 2016-4-26 16:18

本帖最后由四啤酒瓶于 2016-4-26 16:25 编辑

在不同的两个图层：ZN1-2、ZN7-8 分别有不同的线长标记文字如：1m 2m 3m。。。统计不同标记文字的个数，并输出excel。
自个用filter一个一个统计工作量太大了，奈何自个不懂autolisp，研究好几天也弄不出来，请各位大神帮帮忙。

四啤酒瓶 · 发表于 2016-4-26 16:27

，大神快来，大神快来

kozmosovia · 发表于 2016-4-26 18:36

直接用DATAEXTRACTION

highflybir · 发表于 2016-4-26 23:45

看看下面的这个程序是否符合要求。
加载命令是： TJGS

yoyoho · 发表于 2016-4-27 08:31

感谢 "highflybir" 分享程序,谢谢!

longer1000 · 发表于 2016-4-27 09:15

能否不用做成组，直接分层统计

四啤酒瓶 · 发表于 2016-4-27 09:51

highflybir 发表于 2016-4-26 23:45
看看下面的这个程序是否符合要求。
加载命令是： TJGS

谢谢厉害

ㄘ丶转裑ㄧ灬 · 发表于 2016-4-27 11:07

本帖最后由ㄘ丶转裑ㄧ灬于 2016-4-27 11:54 编辑

稍微修改了下，不限于数字开头文本，并附上其它几个统计类程序：

;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;文字统计
;;;;;先用“cdbs-文字重叠变色”检查编号（请查看其注意事项）
;;;;;结果显示在CAD的文本窗口，可复制后粘贴至CAD或EXCEL中，然后用EXCEL的“分列”功能进行数据排版
(defun c:ct ()
(setvar "cmdecho" 0)
(setq ss (ssget '((0 . "text,mtext"))));;;;;;若需统计多行文本，则把"text"改为"text,mtext"
(setq i 0)
(setq tsort '())
(repeat (sslength ss)
(setq ename (ssname ss i))
(setq endate (entget ename))
(setq txt (cdr (assoc 1 endate)))
(setq tsort (cons txt tsort))
(setq i (+ i 1))
)
(setq tsort (vl-sort tsort '<))
(setq j 0)
(setq k 1)
(repeat (length tsort)
(setq trtj (nth j tsort))
(if (/= j (length tsort))
(setq trtn (nth (+ j 1) tsort))
)
(if (= trtj trtn)
(setq k (+ k 1))
(progn
(print (strcat trtj "=" (rtos k 2 0)))
(setq k 1)
)
)
(setq j (+ j 1))
)
(princ "\n编号总数:")
(princ j)
(textscr)
(princ)
)
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;文字统计并输出至Excel
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;by:highflybir
;;Excel至CAD的tab表格：在Excel中复制数据，在CAD中输入PASTESPEC，选择“AutoCAD图元”，确定后输入t，再空格/回车确定，指定基点。
;;CAD的Tab表格转为Excel：输入TABLEEXPORT，选择Tab表格，将保存为CSV文件，可用Excel打开后存为其它格式。
;
;;;;;忘记高飞设了收币了，现只将改动部分显示
;(if (numberp (read (setq num (substr str 1 (1- (strlen str))))));;统计内容为数字的文本
(setq lst (cons (cons (vla-get-layer obj) str) lst))
;)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;*************************文字重叠变色
;;;;;;;;;;;;;;;;;;;;默认改为蓝色，所以请注意原编号中不要有蓝色文字
;;;;;;;;;;;;;;;;;;;;框选时不要把视图缩放到很小，可分几个区域单独操作；视图过小会全改颜色
;;晓东 zxq0220 2014.6.12世界杯前夜
(defun c:cdbs ()
(vl-load-com) ;加载vlisp函数
(if (setq ss (ssget '((0 . "TEXT")))) (progn ;选择操作对象
(setq i 0) ;定义索引号
(repeat (sslength ss) ;遍历选集
(setq en (ssname ss i) ;图元名
ent (entget en) ;关联表
obj (vlax-ename->vla-object en)) ;转化成VLA对象
(vla-getboundingbox obj 'pt1 'pt2) ;文字对象外框
(setq pt1 (vlax-safearray->list pt1) ;转化为坐标
pt2 (vlax-safearray->list pt2))
(if (setq ss1 (ssget "c" pt1 pt2 '((0 . "TEXT"))));TEXT对象
(if (> (sslength (ssdel en ss1)) 0) ;去掉原字串
(if (assoc 62 ent) ;判断是否设定颜色
(entmod (subst '(62 . 5) (assoc 62 ent) ent));改色
(entmod (append ent '((62 . 5))))
)
)
)
(setq i (1+ i))
)
))
(princ)
)
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;********************统计属性文字
;;;;;;;;;*************************(单个属性块有多个属性的请用CAD的数据提取：dataextraction)
;;
;;
;;-----------------=={ Count Attribute Values }==-------------;;
;; ;;
;; Counts the number of occurrences of attribute values in a ;;
;; selection of attributed blocks. Displays result in an ;;
;; AutoCAD Table object. ;;
;;------------------------------------------------------------;;
;;------------------------------------------------------------;;
(defun c:CAV nil (c:CountAttributeValues))
(defun c:CountAttributeValues ( / _Dxf _Assoc++ _SumAttributes ss i alist )
(defun _Dxf ( key alist ) (cdr (assoc key alist)))
(defun _Assoc++ ( key alist )
(
(lambda ( pair )
(if pair
(subst (list key (1+ (cadr pair))) pair alist)
(cons (list key 1) alist)
)
)
(assoc key alist)
)
)
(defun _SumAttributes ( entity alist )
(while
(not
(eq "SEQEND"
(_dxf 0
(entget
(setq entity
(entnext entity)
)
)
)
)
)
(setq alist (_Assoc++ (_Dxf 1 (reverse (entget entity))) alist))
)
)
(cond
(
(not
(vlax-method-applicable-p
(setq space
(vlax-get-property
(setq doc
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)
)
)
'AddTable
)
)
(princ "\n** 这个版本的AutoCAD不支持此功能 **")
)
(
(and (setq ss (ssget '((0 . "INSERT") (66 . 1))))
(repeat (setq i (sslength ss))
(setq alist (_SumAttributes (ssname ss (setq i (1- i))) alist))
)
(setq pt (getpoint "\n指定表格左上角所在点: "))
)
(LM:AddTable space (trans pt 1 0) "属性统计"
(cons '("编号" "总计")
(vl-sort
(mapcar
(function
(lambda ( pair )
(list (car pair) (itoa (cadr pair)))
)
)
alist
)
(function (lambda ( a b ) (< (strcase (car a)) (strcase (car b)))))
)
)
)
)
)
(princ)
)
;;---------------------=={ Add Table }==----------------------;;
;; ;;
;; Creates a VLA Table Object at the specified point, ;;
;; populated with title and data ;;
;;------------------------------------------------------------;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; space - VLA Block Object ;;
;; pt - Insertion Point for Table ;;
;; title - Table title ;;
;; data - List of data to populate the table ;;
;;------------------------------------------------------------;;
;; Returns: VLA Table Object ;;
;;------------------------------------------------------------;;
(defun LM:AddTable ( space pt title data / _itemp ) (vl-load-com)
(defun _itemp ( collection item )
(if
(not
(vl-catch-all-error-p
(setq item
(vl-catch-all-apply 'vla-item (list collection item))
)
)
)
item
)
)
(
(lambda ( table ) (vla-put-StyleName table (getvar 'CTABLESTYLE)) (vla-SetText table 0 0 title)
(
(lambda ( row )
(mapcar
(function
(lambda ( rowitem ) (setq row (1+ row))
(
(lambda ( column )
(mapcar
(function
(lambda ( item )
(vla-SetText table row
(setq column (1+ column)) item
)
)
)
rowitem
)
)
-1
)
)
)
data
)
)
0
)
table
)
(
(lambda ( textheight )
(vla-AddTable space (vlax-3D-point pt) (1+ (length data)) (length (car data)) (* 1.8 textheight)
(* textheight
(apply 'max
(cons (/ (strlen title) (length (car data)))
(mapcar 'strlen (apply 'append data))
)
)
)
)
)
(vla-getTextHeight
(_itemp
(_itemp
(vla-get-Dictionaries
(vla-get-ActiveDocument (vlax-get-acad-object))
)
"ACAD_TABLESTYLE"
)
(getvar 'CTABLESTYLE)
)
acDataRow
)
)
)
)

;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;文字统计 
;;;;;先用“cdbs-文字重叠变色”检查编号（请查看其注意事项） 
;;;;;结果显示在CAD的文本窗口，可复制后粘贴至CAD或EXCEL中，然后用EXCEL的“分列”功能进行数据排版 
(defun c:ct () 
  (setvar "cmdecho" 0) 
  (setq ss (ssget '((0 . "text,mtext"))));;;;;;若需统计多行文本，则把"text"改为"text,mtext" 
  (setq i 0) 
  (setq tsort '()) 
  (repeat (sslength ss) 
    (setq ename (ssname ss i)) 
    (setq endate (entget ename)) 
    (setq txt (cdr (assoc 1 endate))) 
    (setq tsort (cons txt tsort)) 
    (setq i (+ i 1)) 
  ) 
  (setq tsort (vl-sort tsort '<)) 
  (setq j 0) 
  (setq k 1) 
  (repeat (length tsort) 
    (setq trtj (nth j tsort)) 
    (if        (/= j (length tsort)) 
      (setq trtn (nth (+ j 1) tsort)) 
    ) 
    (if        (= trtj trtn) 
      (setq k (+ k 1)) 
      (progn 
        (print (strcat trtj "=" (rtos k 2 0))) 
        (setq k 1) 
      ) 
    ) 
    (setq j (+ j 1)) 
  ) 
  (princ "\n编号总数:") 
  (princ j) 
  (textscr) 
  (princ) 
) 
; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;文字统计并输出至Excel 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;by:highflybir 
;;Excel至CAD的tab表格：在Excel中复制数据，在CAD中输入PASTESPEC，选择“AutoCAD图元”，确定后输入t，再空格/回车确定，指定基点。 
;;CAD的Tab表格转为Excel：输入TABLEEXPORT，选择Tab表格，将保存为CSV文件，可用Excel打开后存为其它格式。 
; 
;;;;;忘记高飞设了收币了，现只将改动部分显示 
        ;(if (numberp (read (setq num (substr str 1 (1- (strlen str))))));;统计内容为数字的文本 
          (setq lst (cons (cons (vla-get-layer obj) str) lst)) 
        ;) 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;*************************文字重叠变色 
;;;;;;;;;;;;;;;;;;;;默认改为蓝色，所以请注意原编号中不要有蓝色文字 
;;;;;;;;;;;;;;;;;;;;框选时不要把视图缩放到很小，可分几个区域单独操作；视图过小会全改颜色 
;;晓东 zxq0220 2014.6.12世界杯前夜 
(defun c:cdbs () 
 (vl-load-com)   ;加载vlisp函数 
 (if (setq ss (ssget '((0 . "TEXT")))) (progn ;选择操作对象 
  (setq i 0)                                  ;定义索引号 
  (repeat (sslength ss)                       ;遍历选集 
   (setq en (ssname ss i)                     ;图元名 
         ent (entget en)                      ;关联表 
         obj (vlax-ename->vla-object en))     ;转化成VLA对象 
   (vla-getboundingbox obj 'pt1 'pt2)         ;文字对象外框 
   (setq pt1 (vlax-safearray->list pt1)       ;转化为坐标 
         pt2 (vlax-safearray->list pt2)) 
   (if (setq ss1 (ssget "c" pt1 pt2 '((0 . "TEXT"))));TEXT对象 
    (if (> (sslength (ssdel en ss1)) 0)       ;去掉原字串 
     (if (assoc 62 ent)                       ;判断是否设定颜色 
      (entmod (subst '(62 . 5) (assoc 62 ent) ent));改色 
      (entmod (append ent '((62 . 5)))) 
     ) 
    ) 
   ) 
   (setq i (1+ i)) 
  ) 
 )) 
 (princ) 
) 
;; 
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;********************统计属性文字 
;;;;;;;;;*************************(单个属性块有多个属性的请用CAD的数据提取：dataextraction) 
;; 
;; 
;;-----------------=={ Count Attribute Values }==-------------;; 
;;                                                            ;; 
;;  Counts the number of occurrences of attribute values in a ;; 
;;  selection of attributed blocks. Displays result in an     ;; 
;;  AutoCAD Table object.                                     ;; 
;;------------------------------------------------------------;; 
;;  Author: Lee Mac, Copyright ?2011 - <a href="http://www.lee-mac.com" target="_blank">www.lee-mac.com</a>       ;; 
;;------------------------------------------------------------;; 
 
(defun c:CAV nil (c:CountAttributeValues)) 
 
(defun c:CountAttributeValues ( / _Dxf _Assoc++ _SumAttributes ss i alist ) 
 
  (defun _Dxf ( key alist ) (cdr (assoc key alist))) 
 
  (defun _Assoc++ ( key alist ) 
    ( 
      (lambda ( pair ) 
        (if pair 
          (subst (list key (1+ (cadr pair))) pair alist) 
          (cons  (list key 1) alist) 
        ) 
      ) 
      (assoc key alist) 
    ) 
  ) 
 
  (defun _SumAttributes ( entity alist ) 
    (while 
      (not 
        (eq "SEQEND" 
          (_dxf 0 
            (entget 
              (setq entity 
                (entnext entity) 
              ) 
            ) 
          ) 
        ) 
      ) 
      (setq alist (_Assoc++ (_Dxf 1 (reverse (entget entity))) alist)) 
    ) 
  ) 
 
  (cond 
    ( 
      (not 
        (vlax-method-applicable-p 
          (setq space 
            (vlax-get-property 
              (setq doc 
                (vla-get-ActiveDocument (vlax-get-acad-object)) 
              ) 
              (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace) 
            ) 
          ) 
          'AddTable 
        ) 
      ) 
 
      (princ "\n** 这个版本的AutoCAD不支持此功能 **") 
    ) 
    ( 
      (and (setq ss (ssget '((0 . "INSERT") (66 . 1)))) 
        (repeat (setq i (sslength ss)) 
          (setq alist (_SumAttributes (ssname ss (setq i (1- i))) alist)) 
        ) 
        (setq pt (getpoint "\n指定表格左上角所在点: ")) 
      ) 
      
      (LM:AddTable space (trans pt 1 0) "属性统计" 
        (cons '("编号" "总计") 
          (vl-sort 
            (mapcar 
              (function 
                (lambda ( pair ) 
                  (list (car pair) (itoa (cadr pair))) 
                ) 
              ) 
              alist 
            ) 
            (function (lambda ( a b ) (< (strcase (car a)) (strcase (car b))))) 
          ) 
        ) 
      ) 
    ) 
  ) 
 
  (princ) 
) 
 
;;---------------------=={ Add Table }==----------------------;; 
;;                                                            ;; 
;;  Creates a VLA Table Object at the specified point,        ;; 
;;  populated with title and data                             ;; 
;;------------------------------------------------------------;; 
;;  Author: Lee Mac, Copyright ?2011 - <a href="http://www.lee-mac.com" target="_blank">www.lee-mac.com</a>       ;; 
;;------------------------------------------------------------;; 
;;  Arguments:                                                ;; 
;;  space - VLA Block Object                                  ;; 
;;  pt    - Insertion Point for Table                         ;; 
;;  title - Table title                                       ;; 
;;  data  - List of data to populate the table                ;; 
;;------------------------------------------------------------;; 
;;  Returns:  VLA Table Object                                ;; 
;;------------------------------------------------------------;; 
 
(defun LM:AddTable ( space pt title data / _itemp ) (vl-load-com) 
 
  (defun _itemp ( collection item ) 
    (if 
      (not 
        (vl-catch-all-error-p 
          (setq item 
            (vl-catch-all-apply 'vla-item (list collection item)) 
          ) 
        ) 
      ) 
      item 
    ) 
  ) 
 
  ( 
    (lambda ( table ) (vla-put-StyleName table (getvar 'CTABLESTYLE)) (vla-SetText table 0 0 title) 
      ( 
        (lambda ( row ) 
          (mapcar 
            (function 
              (lambda ( rowitem ) (setq row (1+ row)) 
                ( 
                  (lambda ( column ) 
                    (mapcar 
                      (function 
                        (lambda ( item ) 
                          (vla-SetText table row 
                            (setq column (1+ column)) item 
                          ) 
                        ) 
                      ) 
                      rowitem 
                    ) 
                  ) 
                  -1 
                ) 
              ) 
            ) 
            data 
          ) 
        ) 
        0 
      ) 
      table 
    ) 
    ( 
      (lambda ( textheight ) 
        (vla-AddTable space (vlax-3D-point pt) (1+ (length data)) (length (car data)) (* 1.8 textheight) 
          (* textheight 
            (apply 'max 
              (cons (/ (strlen title) (length (car data))) 
                (mapcar 'strlen (apply 'append data)) 
              ) 
            ) 
          ) 
        ) 
      ) 
      (vla-getTextHeight 
        (_itemp 
          (_itemp 
            (vla-get-Dictionaries 
              (vla-get-ActiveDocument (vlax-get-acad-object)) 
            ) 
            "ACAD_TABLESTYLE" 
          ) 
          (getvar 'CTABLESTYLE) 
        ) 
        acDataRow 
      ) 
    ) 
  ) 
)

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

[已解答] 求不同图层，不同文字个数，并输出excel

本帖子中包含更多资源

本帖子中包含更多资源

浏览过的版块