求不同图层，不同文字个数，并输出excel
本帖最后由 四啤酒瓶 于 2016-4-26 16:25 编辑在不同的两个图层：ZN1-2、ZN7-8 分别有不同的线长标记文字如：1m 2m 3m。。。统计不同标记文字的个数，并输出excel。
自个用filter一个一个统计工作量太大了，奈何自个不懂autolisp，研究好几天也弄不出来，请各位大神帮帮忙。 ，大神快来，大神快来 直接用DATAEXTRACTION 看看下面的这个程序是否符合要求。
加载命令是 ： TJGS
感谢 "highflybir" 分享程序,谢谢! 能否不用做成组，直接分层统计 highflybir 发表于 2016-4-26 23:45 static/image/common/back.gif
看看下面的这个程序是否符合要求。
加载命令是 ： TJGS
谢谢 厉害 本帖最后由 ㄘ丶转裑ㄧ灬 于 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. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright ?2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
(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 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;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
)
)
)
)
页:
[1]