（更新 5.26）[测试]：园林苗木标注程序。

eachy

Only For 2000+，命令：Ea_LHBZ(（绿化标注）、Ea_SetScale（设置比例），欢迎试用并就其标注格式及苗木统计的规则提供意见，下一步将根据你提供的意见提供苗木统计并自动生成表格的功能。


更新：

动态更新词库

命令：Ea_LhBZ     标注命令
命令：Ea_EdLH     标注编辑
命令：Ea_SetScale 比例设置
命令：Ea_MKTitle  统计表表头及表格生成
命令: TXT_TJ      统计图中相同字串的个数

下载：
http://www.xdcad.net/forum/showt ... d=286213#post286213

doongs

写法应该是比较标准的了
但是在图上可能有很大的自由性吧!
如标乔林的时候常常都要线把乔木都连上，然后才写什么树多少棵这样子
并不是每一个植栽都会写上规格，而是个别的才写出吧。要是每一个都要写，那还不累死人，也没有必要，一般的用一个总的植栽表就能解决!
如果能够按照此法写出能够自动统计的话，那就是大大的方便了，最好能支持一位小数，并且把灌木面积的平方也写到图就，那就标准了

eachy

最初由 doongs 发布
[B]写法应该是比较标准的了
但是在图上可能有很大的自由性吧!
如标乔林的时候常常都要线把乔木都连上，然后才写什么树多少棵这样子
并不是每一个植栽都会写上规格，而是个别的才写出吧。要是每一个都要写，那还不累?.. [/B]

程序还有几个Bug，修改中。

我也仅是对照那个图写的，最好能将各种标法提供个全面图纸。

程序中除了名称以外其他的都为可选项，没有输入的时候是不标注的。

另外，关于统计时的分类有何建议？

aeo

eachy  同志,这几天就忙这事呀.
1.标注(不要每格都填,不然就麻烦,当然少了几项标注要完整.)
2.编辑,也要一个命令的.(大多是copy后改.)这点很重要.
3.统计

eachy

最初由 aeo 发布
[B]eachy  同志,这几天就忙这事呀.
1.标注(不要每格都填,不然就麻烦,当然少了几项标注要完整.)
2.编辑,也要一个命令的.(大多是copy后改.)这点很重要.
3.统计 [/B]

1 所提供所6个选项除第一个名称外，其余的根据需要填写，可以为空
2 程序生成的是属性块，2002中双击即可编辑，Copy后的亦如此编辑
3 统计程序尚未写，这是基础。我没有画过这种图，不知其中的习惯规则，慢慢来。

程序是用VL写的，对此我是新手，向你学习:6

雪晴

乔木数量不要小数，只有灌木统计时需要小数。
在标注苗木规格时设个选项，图上想要标注苗木规格时打个勾，若不想显示时打个x,对话框里的规格始终要填写，便于以后的苗木统计。

doongs

其实还有一个更深层次的问题，那就是以前这个图纸可能不是我画的，我也就无法按照这个方法来写植物的标注!统计也就无从说起了，其实大家最常用的还是“黄杨 5棵”“鸢尾3.2M”(这个M上是带平方的)这们的书书写方式，其实在以前有一个乔木统计的程序，对统计乔木已经相当不错了，但是到了灌木这就不行了，我看这个程序一读到小数点就嘎然而止了，把粘数点当成了字母，后面的小数也就无从提取了，让统计无法正确进行，如果能够修改一个这个程序使之支持小数再结合你这个植物标注的话，就更完美了，自己绘的图统计不在话下，就是别人非标准的模式也能够解决了!
-------------------------
乔木统计的lisp原文如下

2. 
   
3. ;;;----------------------------------------------------------------
   
4. ;;;程序入口
   
5. ;;;
   
6. ;;;
   
7. ;;;可以在这里加入你自己的专业处理函数，形成符合自己专业要求的程序
   
8. ;;;
   
9. ;;;本程序可以免费修改、使用，但在本程序基础上所增添的代码，亦不得
   
10. ;;;收取任何形式的费用，不得进行加密或编译成不可阅读的版本。
    
11. ;;;
    
12. ;;;2002.10.12   by Qlin
    
13. ;;;----------------------------------------------------------------
    
14. (defun c:treecalc (/ lst_tree)
    
15.   ; 数据统计,生成统计数据表
    
16.   (setq lst_tree (treecalc_calculate))
    
17. 
    
18.   ; 表格进一步处理，可加入排序、规格说明、单位等其它数据形成专业数据表
    
19.   
    
20.   ; 数据表输出
    
21.   ; (可以在这里加入表格绘制或数据输出到文件等功能)
    
22.   (princ lst_tree)
    
23. 
    
24.   (princ)
    
25. );end
    
26. 
    
27. ;;;----------------------------------------------------------------
    
28. ;;; 统计所选择的文字，返回统计后的表
    
29. ;;; 2002.10.12 by Qlin
    
30. ;;;----------------------------------------------------------------
    
31. (defun treecalc_calculate (/ ss ent1 str1 n lst_n lst_o n1 lst_all)
    
32.   (setq n 0)
    
33.   (if (setq ss (treecalc_gettext))
    
34.     (while (setq ent1 (ssname ss n))
    
35.       (setq str1 (cdr (assoc 1 (entget ent1))))
    
36.       (setq lst1 (mixstring->list str1))
    
37.       (if (> (length lst1) 1) ;判断文字格式
    
38.         (if (> (atoi (cadr lst1)) 0) ;判断是否含有数字
    
39.           (progn
    
40.             (setq  str2 (car lst1)
    
41.                   lst_n (list str2 (atoi (cadr lst1))))
    
42.             (if (setq lst_o (assoc str2 lst_all))
    
43.               (progn
    
44.                 (setq n1 (+ (cadr lst_n)(cadr lst_o)))
    
45.                 (setq lst_n (list str2 n1))
    
46.                 (setq  lst_all (subst lst_n lst_o lst_all))
    
47.               );progn
    
48.               (setq lst_all (cons lst_n lst_all))
    
49.             );if
    
50.           );progn
    
51.         );if
    
52.       );if
    
53.       (setq n (1+ n))
    
54.     );while
    
55.   );if
    
56.   (setq lst_all (reverse lst_all))
    
57. );end
    
58. 
    
59. ;;;----------------------------------------------------------------
    
60. ;;; 选定指定图层的文字实体,返回符合要求的选择集
    
61. ;;;----------------------------------------------------------------
    
62. (defun treecalc_gettext (/ en ss1 lay)
    
63.   (while (not en)
    
64.     (if (setq en (entsel "\n任选一标注文字以确定参加统计的文字图层："))
    
65.       (if (/= (cdr (assoc 0 (entget (car en)))) "TEXT")
    
66.         (progn
    
67.           (setq en nil)
    
68.           (princ "非文字实体!")
    
69.         );progn
    
70.         (redraw (car en) 3)
    
71.       );if
    
72.     );if
    
73.   );while
    
74.   (setq lay (cdr (assoc 8 (entget (car en)))))
    
75.   (princ "\n  选中<")(princ lay)(princ ">层")
    
76.   (princ ", 现在选择需计算文字实体：")
    
77.   (setq ss1 (ssget (list (cons 0 "TEXT")(cons 8 lay))))
    
78. )
    
79. 
    
80. ;;;----------------------------------------------------------------
    
81. ;;; 将字符串以数字为间隔分解成字符串表
    
82. ;;;----------------------------------------------------------------
    
83. (defun mixstring->list (str_in / lst_out n len1 lst_n
    
84.                       chr_c chr_n chr_p
    
85.                       str_c str_id
    
86.                       num_add str_add)
    
87.   (defun num_add ()
    
88.     (if str_id
    
89.       (progn
    
90.         (if (/= str_c "")(setq lst_out (cons str_c lst_out)))
    
91.         (setq  str_c chr_c
    
92.               str_id nil
    
93.         );setq
    
94.       )
    
95.       (setq str_c (strcat str_c chr_c))
    
96.     );if
    
97.   )
    
98. 
    
99.   (defun str_add ()
    
100.     (if str_id
     
101.       (setq str_c (strcat str_c chr_c))
     
102.       (progn
     
103.         (if (/= str_c "")(setq lst_out (cons str_c lst_out)))
     
104.         (setq  str_c chr_c
     
105.               str_id T
     
106.         );setq
     
107.       )
     
108.     );if
     
109.   )
     
110.   
     
111.   ;C-1: 加入对输入值的判断
     
112.   (if (and str_in (/= str_in ""))
     
113.     (setq len1 (strlen str_in))
     
114.     (setq len1 0)
     
115.   )
     
116.   
     
117.   (setq n 1
     
118.         lst_n (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
     
119.         str_c "")
     
120. 
     
121.   (repeat len1
     
122.     (setq chr_c (substr str_in n 1))
     
123.     (cond
     
124.       ((member chr_c lst_n)
     
125.        (num_add)
     
126.       )
     
127.       ((= chr_c ".")
     
128.        (if (< n len1)
     
129.           (setq chr_n (substr str_in (1+ n) 1))
     
130.          (setq chr_n "")
     
131.        );if
     
132.        (if (member chr_n lst_n)
     
133.          (num_add)
     
134.          (str_add)
     
135.         )      
     
136.       )
     
137.       ((= chr_c "-")
     
138.        (if (< n len1)
     
139.           (setq chr_n (substr str_in (1+ n) 1))
     
140.          (setq chr_n "")
     
141.        );if
     
142.        (if (or (member chr_n lst_n)(= chr_n "."))
     
143.          (num_add)
     
144.          (str_add)
     
145.         )
     
146.       )
     
147.       ((= chr_c "+")
     
148.        (if (< n len1)
     
149.           (setq chr_n (substr str_in (1+ n) 1))
     
150.          (setq chr_n "")
     
151.        );if
     
152.        (if (or (member chr_n lst_n)(= chr_n "."))
     
153.          (num_add)
     
154.          (str_add)
     
155.         )
     
156.       )
     
157.       ((or (= chr_c "E")(= chr_c "e"))
     
158.        (if (< n len1)
     
159.           (setq chr_n (substr str_in (1+ n) 1))
     
160.          (setq chr_n "")
     
161.        );if
     
162.        ;C-2: 修改判断条件使之支持‘2e-3’类型的数据
     
163.        (if (or
     
164.              (and (member chr_n lst_n)(member chr_p lst_n))
     
165.              (and (= chr_n "+")(member chr_p lst_n))
     
166.              (and (= chr_n "-")(member chr_p lst_n))
     
167.            );or
     
168.          (num_add)
     
169.          (str_add)
     
170.         )
     
171.       )
     
172.       (T(str_add))
     
173.     );cond
     
174.    
     
175.     (setq n (1+ n)
     
176.           chr_p chr_c
     
177.     )
     
178.   );repeat
     
179. 
     
180.   (if (> len1 0)
     
181.     (progn
     
182.       (if (/= str_c "")(setq lst_out (cons str_c lst_out)))
     
183.       (setq lst_out (reverse lst_out))
     
184.     );progn
     
185.   );if
     
186.   lst_out
     
187. )

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

eachy

程序的关键是中西文拆分，连续的西文要作为一个字串，  mixstring->list  的弊端是判断 chr ，要将所有的字符都判断，其实换个思路就可以解决，中文是大字符 (ASCII chr)大于 126 的是中文，小于的是西文，用 While 循环就可以将西文拆分开，其中要用到 Vl-string->list 函数。
其实晓东工具葙中已经有中西文拆分的函数，完全可以利用现成的。

aeo

最初由 eachy 发布
[B]
2 程序生成的是属性块，2002中双击即可编辑，Copy后的亦如此编辑
[/B]

还是用那个生成时的对话框多好.一目了然.

还有,谁把常用的灌木,乔木名称分类汇总一下.

雪晴

2

aeo

1.就点两下,出错.
2.180度方向标.错
3.线和文字在一个块里,想移个地方,就只好重标了.
4.无名块,不是好办法.
5.用了很多ea:...舍不得公开?  :)


还有要植物库,只要名称就行.这样:是小数还是整数,是株还是平方米,才能分清楚.名称里也好有个候选.(能不输入就不输入)

eachy

最初由 aeo 发布
[B]1.就点两下,出错.
2.180度方向标.错
3.线和文字在一个块里,想移个地方,就只好重标了.
4.无名块,不是好办法.
5.用了很多ea:...舍不得公开?  :)


还有要植物库,只要名称就行.这样:是小数还是整数,是株还是平方... [/B]

下载地址：http://www.xdcad.net/modrator/file_upload/14/20030518082929_1.swf

1 点两点出错什么意思？
2 180度问题已修改
3  无名块由CAD自动管理，这种情况应用是最佳选择
4  没有什么舍得舍不得，对使用者而言一个文件更方便，如果真舍不得我连程序也不会写。论坛上很多朋友都有我程序的源码，而且每次更新后我都给他们发一份，愿意交流的话上MSN或QQ吧

aeo

1.没有那一拐,就平着标出.应该有这种情况
3.如果想移动,起点就标不到植物上了.


我写的:
希望大家提供比较全的植物名称!

eachy

我是这样处理数量的，当输入数字中含有 m 时标注m2(上标),不用在对话框中输入m2,没有 m 时仅标数字。
植物名称应该建立一个txt文件，可以自定义的，就像建筑中的词库管理。

补充：作为 txt 文件行数也不要太多，可以分成几个文件，否则加入列表后选择起来也不便，文件中的植物命名规则可以参考 过滤器 中的过滤选项

M玫瑰
M.......

这样读入的时候可以用快捷键，

修改了对话框，程序还在完善。

名称后面的选项是标注汉字还是标注代码（还要看文件的格式）选项。空 label 根据乔灌木选择自动调整为 株数、地径 或 面积、胸径。

雪晴

乔木

无患子
雪松
日本柳杉
香樟
日本早樱
......
臭椿
白蜡


灌木


杜鹃
连翘
......