明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2791|回复: 15

[已解答] 求统计列表程序或Lisp,方便最好

[复制链接]
发表于 2014-12-3 00:40 | 显示全部楼层 |阅读模式
10明经币
按我图显示格式,列出图右表格形式,一次性全部生成出来,要考虑重名和节点太多,线交叉和面重叠可能。






附件: 您需要 登录 才可以下载或查看,没有账号?注册
发表于 2014-12-3 00:40 | 显示全部楼层
龙城飞将36 发表于 2014-12-4 11:03
  1. (defun c:tt1()
  2.   (xd::Begin)
  3.   (setq ss    (ssget '((0 . "LWPOLYLINE")))
  4.     ss1   (mapcar '(lambda (X) (append (xdrx_Pickset->ents (ssget  "_CP" (xdrx_entity_getstretchpoint  X) '((0 . "Text")))) (list X) )) (xdrx_Pickset->ents ss))
  5.                 ss1   (vl-sort ss1 (function(lambda (s1 s2) (> (cadr(xdrx_GetPropertyValue (car s1) "position")) (cadr(xdrx_GetPropertyValue (car s2) "position"))))))
  6.           ss2   (mapcar '(lambda (X) (list (xdrx_GetPropertyValue  (cadr x) "Textstring")
  7.           (xdrx_GetPropertyValue  (car x) "Textstring")
  8.           (xdrx_GetPropertyValue  (caddr x) "area"))
  9.       )
  10.       ss1)
  11.   )
  12.   (if (setq pt (getpoint "\n表格插入点: "))
  13.     (progn
  14.       (setq lst       (cons '("人名" "数量" "面积") ss2)
  15.         tb       (xdrx_table_make
  16.           pt
  17.           (+ 2 (length lst))
  18.           8
  19.           4
  20.           6
  21.         )
  22.         ; _制造表格
  23.         colwidth (mapcar '(lambda (x) x)
  24.           '(30 30 40)
  25.         )
  26.         ; _列宽
  27.       )
  28.       (XD::Table:begin tb)
  29.       (mapcar
  30.         '(lambda (x)
  31.           (xdrx_table_settextheight tb x 4)
  32.         )
  33.         '(1 2 4)
  34.       )          ; _设置所有 Cell 文字高度
  35.       (xdrx_table_setalignment tb 1 5)  ; _数据区文字对齐方式
  36.       (xdrx_table_setgridvisibility tb 2 59 nil) ; _隐藏 Title 边
  37.       (mapcar
  38.         '(lambda (x y)
  39.           (xdrx_table_setcolumnwidth tb x y)
  40.         )
  41.         '(0 1 2)
  42.         colwidth
  43.       )
  44.       (setq i 0)
  45.       (mapcar
  46.         '(lambda (x / j)
  47.           (setq j -1
  48.             i (1+ i)
  49.           )
  50.           (mapcar '(lambda (a)
  51.               (xdrx_table_settextstring
  52.                 tb
  53.                 i
  54.                 (setq j (1+ j))
  55.                 (if (eq (type a) 'STR)
  56.                   a
  57.                   (vl-princ-to-string a)
  58.                 )
  59.               )
  60.             )
  61.             x
  62.           )
  63.         )
  64.         lst
  65.       )          ; 构造Cell文字
  66.       (xdrx_table_settextstring tb 0 0 "统计表")
  67.       (XD::Table:end tb)
  68.     )
  69.   )
  70.   (XD::End)
  71.   (princ)
  72. )

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
回复

使用道具 举报

发表于 2014-12-3 05:45 | 显示全部楼层
图纸规矩很好写...但如果图很烂大概就只能收费订制了,写了也不一定能解决...完全是浪费时间....
回复

使用道具 举报

 楼主| 发表于 2014-12-3 09:22 | 显示全部楼层
q3_2006 发表于 2014-12-3 05:45
图纸规矩很好写...但如果图很烂大概就只能收费订制了,写了也不一定能解决...完全是浪费时间....

图的话没什么问题,能帮我解决一部分问题就行。
回复

使用道具 举报

 楼主| 发表于 2014-12-3 10:36 | 显示全部楼层
q3_2006 发表于 2014-12-3 05:45
图纸规矩很好写...但如果图很烂大概就只能收费订制了,写了也不一定能解决...完全是浪费时间....

最好能考虑一下有点质量问题,大部分能列表出来。
回复

使用道具 举报

 楼主| 发表于 2014-12-3 17:31 | 显示全部楼层
有人能带写么,谢谢了,能用就给币。。。
回复

使用道具 举报

发表于 2014-12-4 11:03 | 显示全部楼层
  1. (defun c:tt1()
  2.   (xd::Begin)
  3.   (setq ss    (ssget '((0 . "LWPOLYLINE")))
  4.     ss1   (mapcar '(lambda (X) (append (xdrx_Pickset->ents (ssget  "_CP" (xdrx_entity_getstretchpoint  X) '((0 . "Text")))) (list X) )) (xdrx_Pickset->ents ss))
  5.     ss2   (mapcar '(lambda (X) (list (xdrx_GetPropertyValue  (cadr x) "Textstring")
  6.           (xdrx_GetPropertyValue  (car x) "Textstring")
  7.           (xdrx_GetPropertyValue  (caddr x) "area"))
  8.       )
  9.       ss1)
  10.   )
  11.   (if (setq pt (getpoint "\n表格插入点: "))
  12.     (progn
  13.       (setq lst       (cons '("人名" "数量" "面积") ss2)
  14.         tb       (xdrx_table_make
  15.           pt
  16.           (+ 2 (length lst))
  17.           8
  18.           4
  19.           6
  20.         )
  21.         ; _制造表格
  22.         colwidth (mapcar '(lambda (x) x)
  23.           '(30 30 40)
  24.         )
  25.         ; _列宽
  26.       )
  27.       (XD::Table:begin tb)
  28.       (mapcar
  29.         '(lambda (x)
  30.           (xdrx_table_settextheight tb x 4)
  31.         )
  32.         '(1 2 4)
  33.       )          ; _设置所有 Cell 文字高度
  34.       (xdrx_table_setalignment tb 1 5)  ; _数据区文字对齐方式
  35.       (xdrx_table_setgridvisibility tb 2 59 nil) ; _隐藏 Title 边
  36.       (mapcar
  37.         '(lambda (x y)
  38.           (xdrx_table_setcolumnwidth tb x y)
  39.         )
  40.         '(0 1 2)
  41.         colwidth
  42.       )
  43.       (setq i 0)
  44.       (mapcar
  45.         '(lambda (x / j)
  46.           (setq j -1
  47.             i (1+ i)
  48.           )
  49.           (mapcar '(lambda (a)
  50.               (xdrx_table_settextstring
  51.                 tb
  52.                 i
  53.                 (setq j (1+ j))
  54.                 (if (eq (type a) 'STR)
  55.                   a
  56.                   (vl-princ-to-string a)
  57.                 )
  58.               )
  59.             )
  60.             x
  61.           )
  62.         )
  63.         lst
  64.       )          ; 构造Cell文字
  65.       (xdrx_table_settextstring tb 0 0 "统计表")
  66.       (XD::Table:end tb)
  67.     )
  68.   )
  69.   (XD::End)
  70.   (princ)
  71. )

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
回复

使用道具 举报

 楼主| 发表于 2014-12-4 21:02 | 显示全部楼层
本帖最后由 tyrasv 于 2014-12-4 23:35 编辑
龙城飞将36 发表于 2014-12-4 14:05

用不了啊,谢谢
回复

使用道具 举报

 楼主| 发表于 2014-12-4 21:17 | 显示全部楼层
本帖最后由 tyrasv 于 2014-12-4 23:33 编辑
龙城飞将36 发表于 2014-12-4 14:05
能优化下么,谢谢,用了好多次,都用不了
回复

使用道具 举报

发表于 2014-12-5 08:07 | 显示全部楼层
需要先加载这个
xd-lisp-lib-2014.1130.rar
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-4-26 09:23 , Processed in 0.784119 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表