[编程申请]：晓东及众高手:对带数字的不同文字进行统计及数字汇总.

冰火 · 发表于 2002-9-22 02:59:00

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

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

×

园林绿化种植的施工图设计中,我们需要对不同地方的树木进行文字标注,这些标注分布在图纸的不同地方,树木品种多的时候能达到100多种,最后我们要对同一品种的总数进行汇总,如在图纸中有三处文字标注
香樟10,杜鹃100,银杏5;  香樟20,杜鹃200,银杏10; 香樟20,杜鹃100,银杏15,最后我们要对同一品种的苗木的数字进行相加,得出列表
香樟  50
杜鹃  400
银杏  30
我们现在只能把图纸打印出来后手工分类,数字汇总,费时又容易出错.能不能编一个程序,对所选择的文字进行归类列表,并对汉字后所附带的数字相加汇总?附一张我们的施工图供参考.不好意思,要求有点过分,先多谢了.
我的要求和doogns的"数据统计"是一个内容.doongns一看就是同行,想必也是算趴了,嘿嘿!!!

XDSoft · 发表于 2002-9-22 03:12:46

把你最后统一后，自己绘制的统计表DWG也传到论坛来吧，我直接给你生成最后的图形，这样方便。

冰火 · 发表于 2002-9-22 15:07:25

晓东,谢谢你的回复,上传这张图表是我们统计后的格式(苗木名称和数字不是我上传的那张图,那张图我还没来得及汇总),其中"苗木名称"就是要填入标注的汉字部分,"数量"要填入的就是同一汉字后的数字汇总.其它部分需要设计师根据自己的需要填入.传给你参考.
另:上次传的图汉字标注后有些标了单位M2,可以忽略不考虑,统一按"汉字+数字"的格式考虑.
多谢了!!!!

冰火 · 发表于 2002-9-22 15:10:50

对了,图表的大小可以scale,不过我一般习惯按1:1000绘图,字高为2左右.多谢!!!

ll_j · 发表于 2002-10-8 17:46:39

这是我为一个朋友写的系列程序（线路统计，现在还在继续完善）中的一个，试试，不过只能对单个的“名称＋数字”有效，不能辨别“,”，如果需要以后可以再调整。

doongs · 发表于 2002-10-11 12:40:05

我已经是把黑夜想成了天亮，园林中这样的统计真是太烦了！！

doongs · 发表于 2002-10-11 12:45:45

我怎么下载不了t2.zip那个文件啊，网站打不开！！

Qlin · 发表于 2002-10-12 12:42:28

不知这个问题解决得如何了？
若没有我或许可以试试

XDSoft · 发表于 2002-10-12 12:50:23

最初由 Qlin 发布
[B]不知这个问题解决得如何了？
若没有我或许可以试试 [/B]

QLIN,给大家写个纯LISP的代码吧，谢谢！

caibaobao · 发表于 2002-10-12 15:25:12

我也碰到过这样得问题，望各位高手帮忙解决，谢谢拉！

Qlin · 发表于 2002-10-12 15:45:13

我写了数据收集和数据统计两部分的代码，
其它的希望大家来一起合作。

基本上交互界面是这样的(以第一张帖子的图为例)：
[B]
Command: treecalc
任选一标注文字以确定参加统计的文字图层：
选中<苗木文字>层, 现在选择需计算文字实体：
Select objects: all
970 found
886 were filtered out.
Select objects:
[/B]
目前输出结果：
[B]
((草花 18) (瓜子黄杨球 26) (棕榈 25) (银杏 11) (红花美人蕉 26) (大桂花 8)
(红花继木球 11) (下小龙柏 33) (青枫 3) (榉树 5) (下杜鹃 160) (下红花酢浆草 236)
(瓜子黄杨 158) (紫叶小檗 40) (金叶女贞 123) (下麦冬 115) (珊瑚树 488) (红枫 6)
(枸骨球 8) (黄馨 280) (慈孝竹 75) (丰花月季 53) (下射干 100) (白玉兰 3) (小龙柏
145) (金丝桃 58) (下南天竹 60) (合欢 4) (白花三叶草 90) (下桃叶珊瑚 30)
(下狭叶十大功劳 60) (杜英 6) (紫鹃 70) (雪松 5) (大银杏 4) (香樟 45) (桂花 60)
(广玉兰 3) (垂丝海棠 17) (木槿 65) (罗汉松 77) (山茶 40) (石楠 45) (八角金盘
260) (紫薇 30) (花石榴 30))
[/B]

;;;----------------------------------------------------------------
;;;程序入口
;;;
;;;
;;;可以在这里加入你自己的专业处理函数，形成符合自己专业要求的程序
;;;
;;;本程序可以免费修改、使用，但在本程序基础上所增添的代码，亦不得
;;;收取任何形式的费用，不得进行加密或编译成不可阅读的版本。
;;;
;;;2002.10.12 by Qlin
;;;----------------------------------------------------------------
(defun c:treecalc (/ lst_tree)
; 数据统计,生成统计数据表
(setq lst_tree (treecalc_calculate))
; 表格进一步处理，可加入排序、规格说明、单位等其它数据形成专业数据表
; 数据表输出
; (可以在这里加入表格绘制或数据输出到文件等功能)
(princ lst_tree)
(princ)
);end
;;;----------------------------------------------------------------
;;; 统计所选择的文字，返回统计后的表
;;; 2002.10.12 by Qlin
;;;----------------------------------------------------------------
(defun treecalc_calculate (/ ss ent1 str1 n lst_n lst_o n1 lst_all)
(setq n 0)
(if (setq ss (treecalc_gettext))
(while (setq ent1 (ssname ss n))
(setq str1 (cdr (assoc 1 (entget ent1))))
(setq lst1 (mixstring->list str1))
(if (> (length lst1) 1) ;判断文字格式
(if (> (atoi (cadr lst1)) 0) ;判断是否含有数字
(progn
(setq str2 (car lst1)
lst_n (list str2 (atoi (cadr lst1))))
(if (setq lst_o (assoc str2 lst_all))
(progn
(setq n1 (+ (cadr lst_n)(cadr lst_o)))
(setq lst_n (list str2 n1))
(setq lst_all (subst lst_n lst_o lst_all))
);progn
(setq lst_all (cons lst_n lst_all))
);if
);progn
);if
);if
(setq n (1+ n))
);while
);if
(setq lst_all (reverse lst_all))
);end
;;;----------------------------------------------------------------
;;; 选定指定图层的文字实体,返回符合要求的选择集
;;;----------------------------------------------------------------
(defun treecalc_gettext (/ en ss1 lay)
(while (not en)
(if (setq en (entsel "\n任选一标注文字以确定参加统计的文字图层："))
(if (/= (cdr (assoc 0 (entget (car en)))) "TEXT")
(progn
(setq en nil)
(princ "非文字实体!")
);progn
(redraw (car en) 3)
);if
);if
);while
(setq lay (cdr (assoc 8 (entget (car en)))))
(princ "\n 选中<")(princ lay)(princ ">层")
(princ ", 现在选择需计算文字实体：")
(setq ss1 (ssget (list (cons 0 "TEXT")(cons 8 lay))))
)
;;;----------------------------------------------------------------
;;; 将字符串以数字为间隔分解成字符串表
;;;----------------------------------------------------------------
(defun mixstring->list (str_in / lst_out n len1 lst_n
chr_c chr_n chr_p
str_c str_id
num_add str_add)
(defun num_add ()
(if str_id
(progn
(if (/= str_c "")(setq lst_out (cons str_c lst_out)))
(setq str_c chr_c
str_id nil
);setq
)
(setq str_c (strcat str_c chr_c))
);if
)
(defun str_add ()
(if str_id
(setq str_c (strcat str_c chr_c))
(progn
(if (/= str_c "")(setq lst_out (cons str_c lst_out)))
(setq str_c chr_c
str_id T
);setq
)
);if
)
;C-1: 加入对输入值的判断
(if (and str_in (/= str_in ""))
(setq len1 (strlen str_in))
(setq len1 0)
)
(setq n 1
lst_n (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
str_c "")
(repeat len1
(setq chr_c (substr str_in n 1))
(cond
((member chr_c lst_n)
(num_add)
)
((= chr_c ".")
(if (< n len1)
(setq chr_n (substr str_in (1+ n) 1))
(setq chr_n "")
);if
(if (member chr_n lst_n)
(num_add)
(str_add)
)
)
((= chr_c "-")
(if (< n len1)
(setq chr_n (substr str_in (1+ n) 1))
(setq chr_n "")
);if
(if (or (member chr_n lst_n)(= chr_n "."))
(num_add)
(str_add)
)
)
((= chr_c "+")
(if (< n len1)
(setq chr_n (substr str_in (1+ n) 1))
(setq chr_n "")
);if
(if (or (member chr_n lst_n)(= chr_n "."))
(num_add)
(str_add)
)
)
((or (= chr_c "E")(= chr_c "e"))
(if (< n len1)
(setq chr_n (substr str_in (1+ n) 1))
(setq chr_n "")
);if
;C-2: 修改判断条件使之支持‘2e-3’类型的数据
(if (or
(and (member chr_n lst_n)(member chr_p lst_n))
(and (= chr_n "+")(member chr_p lst_n))
(and (= chr_n "-")(member chr_p lst_n))
);or
(num_add)
(str_add)
)
)
(T(str_add))
);cond
(setq n (1+ n)
chr_p chr_c
)
);repeat
(if (> len1 0)
(progn
(if (/= str_c "")(setq lst_out (cons str_c lst_out)))
(setq lst_out (reverse lst_out))
);progn
);if
lst_out
)

;;;---------------------------------------------------------------- 
;;;程序入口 
;;; 
;;; 
;;;可以在这里加入你自己的专业处理函数，形成符合自己专业要求的程序 
;;; 
;;;本程序可以免费修改、使用，但在本程序基础上所增添的代码，亦不得 
;;;收取任何形式的费用，不得进行加密或编译成不可阅读的版本。 
;;; 
;;;2002.10.12   by Qlin 
;;;---------------------------------------------------------------- 
(defun c:treecalc (/ lst_tree) 
  ; 数据统计,生成统计数据表 
  (setq lst_tree (treecalc_calculate)) 
 
  ; 表格进一步处理，可加入排序、规格说明、单位等其它数据形成专业数据表 
   
  ; 数据表输出 
  ; (可以在这里加入表格绘制或数据输出到文件等功能) 
  (princ lst_tree) 
 
  (princ) 
);end 
 
;;;---------------------------------------------------------------- 
;;; 统计所选择的文字，返回统计后的表 
;;; 2002.10.12 by Qlin 
;;;---------------------------------------------------------------- 
(defun treecalc_calculate (/ ss ent1 str1 n lst_n lst_o n1 lst_all) 
  (setq n 0) 
  (if (setq ss (treecalc_gettext)) 
    (while (setq ent1 (ssname ss n)) 
      (setq str1 (cdr (assoc 1 (entget ent1)))) 
      (setq lst1 (mixstring->list str1)) 
      (if (> (length lst1) 1) ;判断文字格式 
        (if (> (atoi (cadr lst1)) 0) ;判断是否含有数字 
          (progn 
            (setq  str2 (car lst1) 
                  lst_n (list str2 (atoi (cadr lst1)))) 
            (if (setq lst_o (assoc str2 lst_all)) 
              (progn 
                (setq n1 (+ (cadr lst_n)(cadr lst_o))) 
                (setq lst_n (list str2 n1)) 
                (setq  lst_all (subst lst_n lst_o lst_all)) 
              );progn 
              (setq lst_all (cons lst_n lst_all)) 
            );if 
          );progn 
        );if 
      );if 
      (setq n (1+ n)) 
    );while 
  );if 
  (setq lst_all (reverse lst_all)) 
);end 
 
;;;---------------------------------------------------------------- 
;;; 选定指定图层的文字实体,返回符合要求的选择集 
;;;---------------------------------------------------------------- 
(defun treecalc_gettext (/ en ss1 lay) 
  (while (not en) 
    (if (setq en (entsel "\n任选一标注文字以确定参加统计的文字图层：")) 
      (if (/= (cdr (assoc 0 (entget (car en)))) "TEXT") 
        (progn 
          (setq en nil) 
          (princ "非文字实体!") 
        );progn 
        (redraw (car en) 3) 
      );if 
    );if 
  );while 
  (setq lay (cdr (assoc 8 (entget (car en))))) 
  (princ "\n  选中<")(princ lay)(princ ">层") 
  (princ ", 现在选择需计算文字实体：") 
  (setq ss1 (ssget (list (cons 0 "TEXT")(cons 8 lay)))) 
) 
 
;;;---------------------------------------------------------------- 
;;; 将字符串以数字为间隔分解成字符串表 
;;;---------------------------------------------------------------- 
(defun mixstring->list (str_in / lst_out n len1 lst_n 
                      chr_c chr_n chr_p 
                      str_c str_id 
                      num_add str_add) 
  (defun num_add () 
    (if str_id 
      (progn 
        (if (/= str_c "")(setq lst_out (cons str_c lst_out))) 
        (setq  str_c chr_c 
              str_id nil 
        );setq 
      ) 
      (setq str_c (strcat str_c chr_c)) 
    );if 
  ) 
 
  (defun str_add () 
    (if str_id 
      (setq str_c (strcat str_c chr_c)) 
      (progn 
        (if (/= str_c "")(setq lst_out (cons str_c lst_out))) 
        (setq  str_c chr_c 
              str_id T 
        );setq 
      ) 
    );if 
  ) 
   
  ;C-1: 加入对输入值的判断 
  (if (and str_in (/= str_in "")) 
    (setq len1 (strlen str_in)) 
    (setq len1 0) 
  ) 
   
  (setq n 1 
        lst_n (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9") 
        str_c "") 
 
  (repeat len1 
    (setq chr_c (substr str_in n 1)) 
    (cond 
      ((member chr_c lst_n) 
       (num_add) 
      ) 
      ((= chr_c ".") 
       (if (< n len1) 
          (setq chr_n (substr str_in (1+ n) 1)) 
         (setq chr_n "") 
       );if 
       (if (member chr_n lst_n) 
         (num_add) 
         (str_add) 
        )       
      ) 
      ((= chr_c "-") 
       (if (< n len1) 
          (setq chr_n (substr str_in (1+ n) 1)) 
         (setq chr_n "") 
       );if 
       (if (or (member chr_n lst_n)(= chr_n ".")) 
         (num_add) 
         (str_add) 
        ) 
      ) 
      ((= chr_c "+") 
       (if (< n len1) 
          (setq chr_n (substr str_in (1+ n) 1)) 
         (setq chr_n "") 
       );if 
       (if (or (member chr_n lst_n)(= chr_n ".")) 
         (num_add) 
         (str_add) 
        ) 
      ) 
      ((or (= chr_c "E")(= chr_c "e")) 
       (if (< n len1) 
          (setq chr_n (substr str_in (1+ n) 1)) 
         (setq chr_n "") 
       );if 
       ;C-2: 修改判断条件使之支持‘2e-3’类型的数据 
       (if (or 
             (and (member chr_n lst_n)(member chr_p lst_n)) 
             (and (= chr_n "+")(member chr_p lst_n)) 
             (and (= chr_n "-")(member chr_p lst_n)) 
           );or 
         (num_add) 
         (str_add) 
        ) 
      ) 
      (T(str_add)) 
    );cond 
    
    (setq n (1+ n) 
          chr_p chr_c 
    ) 
  );repeat 
 
  (if (> len1 0) 
    (progn 
      (if (/= str_c "")(setq lst_out (cons str_c lst_out))) 
      (setq lst_out (reverse lst_out)) 
    );progn 
  );if 
  lst_out 
)

冰火 · 发表于 2002-10-12 21:50:53

ll j兄的程序我试了一下,他没有对所选汉字没有归类列表的功能,这对我们来说还是不大方便,因为如果设计的有100个品种的话,我就必须选择壹佰次,并在对话框中分别输入100个苗木品种的名称,太麻烦了!不过他的程序有一个非常好的地方,就是在一个品种文字汇总后可以查相加汇总前的具体数字,便于检查.无论如何多谢多谢!!
其实不一定要列出一个最终的苗木表,只要对所选择的文字进行归类列表,并对汉字后所附带的数字相加汇总就可以了.多谢xdsoft及众高手的鼎力支持,我在盼呀盼..........

冰火 · 发表于 2002-10-13 00:07:37

刚看到Qlin兄的程序,用以前的工程试了一试,正是我们所希望的东西,太感谢了,这简直是人性的解放!!!以后在具体的工程中用后如有什么问题再向各位高手请教.
向ll-j，xdsoft、Qlin致以最诚挚的谢意，你们可真是大好人。。。。。:4:4

aeo · 发表于 2002-10-28 00:11:25

;树木统计 tj
;名称"树2木100"-- >("树""2.0") "树2e+2"-- >("树""200.0")
;直接以选集的第一个字的字型书写.
;如有改进请告知
;分离文字和数字,我的方法大家看看
(defun c:tj( / dxf maketext break-it all all-tree e0 hi j lay len li1 name p1 p2 ss sty swap tree)
(defun dxf(NO SWA) (CDR (ASSOC NO SWA)))
(defun maketext(nowstr p1 sty hi / li-str)
(setq li-str
(list
'(0 . "TEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 8 lay)
(cons 10 p1)
(cons 40 hi)
(cons 1 nowstr)
'(41 . 0.7)
(cons 7 sty)
'(100 . "AcDbText") ) )
(entmake li-str)
)
;;;;;;;;;;;;***************
(defun break-it(name / j len n1 n2 ture) ; "abc12"-->("abc""12.0") | "abc" or "123"-->nil | "abc23M"-->("abc""23.0")
(setq len(strlen name) j 1)
(while(<= j len)
(setq n1(substr name 1 (1- j)) n2(substr name j) )
(if(/= 0(atof n2 ))(setq ture(list n1 n2) j(1+ len) )(setq ture nil))
(setq j (1+ j))
)(if(and ture(= ""(car ture)))(setq ture nil)) ;统计纯数字去这一行if...
ture)
;;;;;;;;;;;;;;*************
(setq swap(car(entsel)))
(if swap(setq lay(dxf 8(entget swap))))
(setq ss(ssget (list(cons 8 lay)(cons 0 "*TEXT"))))
(setq j 0 len(sslength ss))
(setq all '() tree '())
(while(< j len)
(setq e0(entget(ssname ss j)) name(dxf 1 e0))
(if(= j 0)(setq sty(dxf 7 e0) hi (dxf 40 e0)))
(while (= 32(ascii name))(setq name (substr name 2))) ;去前空格
(setq li1(break-it name)name(car li1) )
(if li1
(if (member name tree)
(setq all(subst(append (assoc name all)(list(cadr li1)))(assoc name all) all) )
(setq tree(cons name tree)all(cons li1 all) )
)
)(setq j(1+ j))
) ;all---->(("A" "2" "3"...)("B" "4" "5"...)...)
(setq all-tree '()) ;all-tree----->(("A" "12.2")("B""45.0")...)
(foreach x all(setq all-tree(cons(list(car x)(rtos(apply '+(mapcar 'atof(cdr x)))2 1)) all-tree)))
;all-tree排序,在这一行加
(setq all-tree(cons(list "名称""数量")all-tree))
(setq p1(getpoint "Point to Draw:"))
(command"undo""group")
(foreach x all-tree ;draw it now
(maketext (car x)p1 sty hi)
(setq p2(polar p1 0(* hi 10)))
(maketext (cadr x)p2 sty hi)
(setq p1(polar p1 (* pi 1.5)(* 1.2 hi)))
)
(command"undo""end")
(princ "OK!")(princ)
)

;树木统计  tj 
;名称"树2木100"-- >("树""2.0")  "树2e+2"-- >("树""200.0") 
;直接以选集的第一个字的字型书写. 
;如有改进请告知 
;分离文字和数字,我的方法大家看看 
(defun c:tj( / dxf maketext break-it all all-tree e0 hi j lay len li1 name p1 p2 ss sty swap tree) 
 (defun dxf(NO SWA) (CDR (ASSOC NO SWA))) 
 (defun maketext(nowstr p1 sty hi / li-str) 
   (setq li-str 
   (list 
    '(0 . "TEXT") 
    '(100 . "AcDbEntity") 
    '(100 . "AcDbText") 
     (cons 8 lay) 
     (cons 10 p1) 
     (cons 40 hi) 
     (cons 1 nowstr) 
    '(41 . 0.7) 
     (cons 7 sty) 
    '(100 . "AcDbText")  ) ) 
    (entmake li-str) 
 ) 
 ;;;;;;;;;;;;*************** 
 (defun break-it(name / j len n1 n2 ture)    ; "abc12"-->("abc""12.0")  |  "abc" or "123"-->nil   | "abc23M"-->("abc""23.0") 
  (setq len(strlen name) j 1) 
  (while(<= j len) 
   (setq n1(substr name 1 (1- j)) n2(substr name j) ) 
   (if(/= 0(atof n2 ))(setq ture(list n1 n2) j(1+ len) )(setq ture nil)) 
   (setq j (1+ j)) 
  )(if(and ture(= ""(car ture)))(setq ture nil))    ;统计纯数字去这一行if... 
  ture) 
 ;;;;;;;;;;;;;;************* 
 (setq swap(car(entsel))) 
 (if swap(setq lay(dxf 8(entget swap)))) 
 (setq ss(ssget (list(cons 8 lay)(cons 0 "*TEXT")))) 
 (setq j 0 len(sslength ss)) 
 (setq all '() tree '()) 
(while(< j len) 
  (setq e0(entget(ssname ss j)) name(dxf 1 e0)) 
  (if(= j 0)(setq sty(dxf 7 e0) hi (dxf 40 e0)))    
  (while (= 32(ascii name))(setq name (substr name 2)))      ;去前空格 
  (setq li1(break-it name)name(car li1) ) 
  (if li1 
   (if (member name tree) 
   (setq all(subst(append (assoc name all)(list(cadr li1)))(assoc name all) all) ) 
   (setq tree(cons name tree)all(cons li1 all) ) 
   ) 
  )(setq j(1+ j))            
 )                                                 ;all---->(("A" "2" "3"...)("B" "4" "5"...)...) 
 (setq all-tree '())                               ;all-tree----->(("A" "12.2")("B""45.0")...) 
 (foreach x all(setq all-tree(cons(list(car x)(rtos(apply '+(mapcar 'atof(cdr x)))2 1)) all-tree))) 
   ;all-tree排序,在这一行加 
 (setq all-tree(cons(list "名称""数量")all-tree)) 
 (setq p1(getpoint "Point to Draw:")) 
 (command"undo""group") 
 (foreach x all-tree                               ;draw it now 
   (maketext (car x)p1 sty hi) 
    (setq p2(polar p1 0(* hi 10))) 
    (maketext (cadr x)p2 sty hi) 
   (setq p1(polar p1 (* pi 1.5)(* 1.2 hi))) 
 ) 
 (command"undo""end") 
 (princ "OK!")(princ) 
 )

XDSoft · 发表于 2002-10-28 00:15:01

最初由 aeo 发布
[B][code]
;Ê÷Ä¾Í³¼Æ tj
;Ãû³ÆÀï²»ÄÜ³öÏÖÊý×Ö example: ²&... [/B]

谢谢AEO，你的注释汉字是乱码，能不能编辑下帖子，修改下。

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

[编程申请]：晓东及众高手:对带数字的不同文字进行统计及数字汇总.

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

相关帖子