根据数据值分区，并用颜色标记

口味虾

结构专业在筏板，楼板钢筋等场合根据计算面积配筋的时候，根据自定义的数据范围，用颜色分别标示，这样可以直接配钢筋，不用再对着表一个个的看了。其他专业如果有类似需求，可以自己改造。
自定义范围写在xls文件中，默认文件名fenqu.xls，放在d盘根目录
有建议或者意见的请跟帖，谢谢。

2. (defun c:fenqu ( / ss ssn xls_lst  lst en_str en_num cor_1)
   
3. (princ "提示：操作前请先在xls文件中定义好值范围和颜色")
   
4.   (setq ss (ssget '((0 . "text"))))
   
5.   (setq ssn (xdrx_Pickset->ents ss))
   
6. 
   
7.   (xdex_book_open "d:\\fenqu.xls")
   
8.   (xdex_book_setactivesheet (- 1 (getint "请输入工作簿的索引号(即第几个工作簿)  ")))
   
9.   
   
10.   (setq xls_lst (xdex_cell_readrange 1 0))
    
11.   (setq  lst (mapcar '(lambda (x)
    
12. 
    
13.            (mapcar '(lambda (e) (nth 1 e)) x)
    
14. 
    
15.          )
    
16.         xls_lst
    
17.       )
    
18.   )
    
19. 
    
20. 
    
21. 
    
22. 
    
23. 
    
24.   (foreach en ssn
    
25.     (progn
    
26. 
    
27.       (setq en_str (xdrx_text_string en))
    
28.       (setq en_num (atof en_str))
    
29. 
    
30. 
    
31.           ;   (setq cor (cadr (assoc "Color" (xdrx_entity_getProperty en))))
    
32.       (setq cor_1 0)
    
33. 
    
34.       (foreach xx lst
    
35.   (progn
    
36.     (if (and
    
37.     (>= en_num (nth 0 xx))
    
38.     (< en_num (nth 1 xx))
    
39. 
    
40.         )
    
41.       (progn
    
42.         (setq cor_1 (+ cor_1 (nth 2 xx)))
    
43. 
    
44.       )
    
45.     )
    
46.   )
    
47.       )
    
48.       (if (> cor_1 0.0)
    
49.   (progn
    
50.           ; (princ cor_1)
    
51.           ;(princ en)
    
52.           ;    (princ "----")
    
53.     (xdrx_entity_setColor en (fix cor_1))
    
54.   )
    
55.       )
    
56.     )
    
57. 
    
58. 
    
59. 
    
60. 
    
61.   )
    
62. 
    
63.   (xdex_book_close)
    
64.   (princ)
    
65. )

(defun c:fenqu ( / ss ssn xls_lst  lst en_str en_num cor_1)<br /> (princ "提示：操作前请先在xls文件中定义好值范围和颜色")<br />   (setq ss (ssget '((0 . "text"))))<br />   (setq ssn (xdrx_Pickset->ents ss))<br /> <br />   (xdex_book_open "d:\\fenqu.xls")<br />   (xdex_book_setactivesheet (- 1 (getint "请输入工作簿的索引号(即第几个工作簿)  ")))<br />   <br />   (setq xls_lst (xdex_cell_readrange 1 0))<br />   (setq  lst (mapcar '(lambda (x)<br /> <br />            (mapcar '(lambda (e) (nth 1 e)) x)<br /> <br />          )<br />         xls_lst<br />       )<br />   )<br /> <br /> <br /> <br /> <br /> <br />   (foreach en ssn<br />     (progn<br /> <br />       (setq en_str (xdrx_text_string en))<br />       (setq en_num (atof en_str))<br /> <br /> <br />           ;   (setq cor (cadr (assoc "Color" (xdrx_entity_getProperty en))))<br />       (setq cor_1 0)<br /> <br />       (foreach xx lst<br />   (progn<br />     (if (and<br />     (>= en_num (nth 0 xx))<br />     (< en_num (nth 1 xx))<br /> <br />         )<br />       (progn<br />         (setq cor_1 (+ cor_1 (nth 2 xx)))<br /> <br />       )<br />     )<br />   )<br />       )<br />       (if (> cor_1 0.0)<br />   (progn<br />           ; (princ cor_1)<br />           ;(princ en)<br />           ;    (princ "----")<br />     (xdrx_entity_setColor en (fix cor_1))<br />   )<br />       )<br />     )<br /> <br /> <br /> <br /> <br />   )<br /> <br />   (xdex_book_close)<br />   (princ)<br /> )

xls设置

            

xls设置2

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:fenqu.xls 
下载次数:1  文件大小:18.5 KB 
下载权限: 不限 以上  [免费赚D豆]

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:fenqu.LSP 
下载次数:9  文件大小:1.08 KB 
下载权限: 不限 以上  [免费赚D豆]

newer

精彩，漂亮，希望看到更多的用API写的应用。

newer

提一个建议，程序里面foreach的，试试用mapcar写。

amwkto2011

newer 发表于 2014-12-17 22:36
提一个建议，程序里面foreach的，试试用mapcar写。

为什么要这样啊，要用mapcar
我也刚接触这两个函数,不是很会

Lispboy

amwkto2011 发表于 2014-12-18 21:25
为什么要这样啊，要用mapcar
我也刚接触这两个函数,不是很会

mapcar效率更高些，处理表它有先天优势，哪不会，可以发帖讨论。

newer

amwkto2011 发表于 2014-12-18 21:25
为什么要这样啊，要用mapcar
我也刚接触这两个函数,不是很会

比如下面表：

(("abc" 3434)("def" 35435)("efag" 344))

你想获得里面子表的第一个元素组成的表， ("abc" "def" "efag" ) 你怎么做？你用mapcar 就很快捷了

(mapcar 'car (("abc" 3434)("def" 35435)("efag" 344))) ==("abc" "def" "efag" )


那取得第二个元素组成的表，怎么做？

m786372966

不错，挺好的，赞一个。

amwkto2011

newer 发表于 2014-12-18 22:11
比如下面表：

(("abc" 3434)("def" 35435)("efag" 344))

(mapcar 'car (("abc" 3434)("def" 35435)("efag" 344)))==错误: 函数错误: "def"
出错啦
(mapcar 'car (list '("abc" 3434) '("def" 35435) '("efag" 344)))==("abc" "def" "efag")
(mapcar 'cadr (list '("abc" 3434) '("def" 35435) '("efag" 344)))==(3434 35435 344)
我只会弄这样简单的了

newer

amwkto2011 发表于 2014-12-19 11:30
(mapcar 'car (("abc" 3434)("def" 35435)("efag" 344)))==错误: 函数错误: "def"
出错啦
(mapcar 'car ...

(("abc" 3434)("def" 35435)("efag" 344)) 这个表前面应该加个 ‘

amwkto2011

Lispboy 发表于 2014-12-18 21:35
mapcar效率更高些，处理表它有先天优势，哪不会，可以发帖讨论。

要怎么说叫呢
（mapcar 函数 表） 这个还是理解的
就是中间的函数，不会定义
如（lambda）
定义(defun hu_aa)
这样的我会定义一个处理功能，多个就不行了

newer

amwkto2011 发表于 2014-12-19 11:41
要怎么说叫呢
（mapcar 函数 表） 这个还是理解的
就是中间的函数，不会定义

和你外面定义的函数是一样的，只是没有名字