按编号顺序将网格的周长面积输出到EXCEL表

sicky111 · 发表于 2014-12-30 15:31:22

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

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

×

最近看到很多高手发布了有关EXCEL的函数，应该有很多高手对CAD→EXCEL有深入研究。所以想求助一个功能，能够获取图档中所有网格的长、宽、周长、面积，按网格编号的顺序，输出到EXCEL中，并需抓取图框中一些文字，按固定的格式绘制成表，不如该如何实现，希望各位热心大侠能够帮忙。

请点击此处下载

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

您的用户组是：游客

文件名称:tt.rar
下载次数:168 文件大小:54.11 KB
下载权限: 不限以上 [免费赚D豆]

st788796 · 发表于 2014-12-30 17:30:46

st788796 发表于 2014-12-30 16:55
直接在后面回复

加上排序, 再简单处理下就可以批量写到 xls 了

在后面跟帖！

游客，如果您要查看本帖隐藏内容请回复

st788796 · 发表于 2014-12-30 15:41:37

既然是固定格式，最好先做好这个 XLS ，后面直接往里写，不要用程序再去计算，这样才能高效方便，你先制好这样一个 xls

st788796 · 发表于 2014-12-30 15:45:17

你这个要有前处理，都是拿 Line 绘制的就要说是一个网格，图层也不再一起，先说说哪些算网格吧

st788796 · 发表于 2014-12-30 16:32:44

简单写了下，返回 ((编号 BOX 周长面积) ....) 这样一个表

(defun c:tt (/ ss s1 s2 tlst plst ss1 ss2 lst rlst result)
(if (and (setq ss (ssget '((-4 . "<or")
(-4 . "<and")
(0 . "text")
(8 . "编号")
(-4 . "and>")
(-4 . "<and")
(0 . "line")
(8 . "L*")
(-4 . "and>")
(-4 . "or>")
)
)
)
(setq s1 (ssget "P"
'((0 . "text")
(8 . "编号")
)
)
)
(setq s2 (xdrx_pickset_subtract ss s1))
)
(progn
(setq tlst (mapcar '(lambda (x)
(xdrx_getpropertyvalue x "Position" "textstring")
)
(xdrx_pickset->ents s1)
)
ss1 (xdrx_entity_transformedcopy s2 (xdrx_matrix_identity 3))
ss1 (xdrx_curve_intersectbreak ss1 0.1)
ss2 (xdrx_geom_searchRegions ss1 0)
lst (mapcar
'(lambda (x)
(xdrx_getpropertyvalue
x
"BoundingBox"
"Length"
"Area"
)
)
(xdrx_pickset->ents ss2)
)
rlst (cdr (vl-sort lst
'(lambda (x1 x2)
(> (last x1) (last x2))
)
)
)
result (vl-remove
nil
(mapcar '(lambda (x / l)
(if (setq l (vl-member-if
'(lambda (a)
(apply 'xdrx_point_isinside
(cons (car a) (car x))
)
)
tlst
)
)
(cons (cadr l) x)
)
)
rlst
)
)
)
(xdrx_entity_delete ss2)
(princ (car result))
)
)
(princ)
)

(defun c:tt (/ ss s1 s2 tlst plst ss1 ss2 lst rlst result) 
  (if (and (setq ss (ssget '((-4 . "<or") 
                             (-4 . "<and") 
                             (0 . "text") 
                             (8 . "编号") 
                             (-4 . "and>") 
                             (-4 . "<and") 
                             (0 . "line") 
                             (8 . "L*") 
                             (-4 . "and>") 
                             (-4 . "or>") 
                            ) 
                    ) 
           ) 
           (setq s1 (ssget "P" 
                           '((0 . "text") 
                             (8 . "编号") 
                            ) 
                    ) 
           ) 
           (setq s2 (xdrx_pickset_subtract ss s1)) 
      ) 
    (progn 
      (setq tlst   (mapcar '(lambda (x) 
                              (xdrx_getpropertyvalue x "Position" "textstring") 
                            ) 
                           (xdrx_pickset->ents s1) 
                   ) 
            ss1           (xdrx_entity_transformedcopy s2 (xdrx_matrix_identity 3)) 
            ss1           (xdrx_curve_intersectbreak ss1 0.1) 
            ss2           (xdrx_geom_searchRegions ss1 0) 
            lst           (mapcar 
                     '(lambda (x) 
                        (xdrx_getpropertyvalue 
                          x 
                          "BoundingBox" 
                          "Length" 
                          "Area" 
                        ) 
                      ) 
                     (xdrx_pickset->ents ss2) 
                   ) 
            rlst   (cdr        (vl-sort lst 
                                 '(lambda (x1 x2) 
                                    (> (last x1) (last x2)) 
                                  ) 
                        ) 
                   ) 
            result (vl-remove 
                     nil 
                     (mapcar '(lambda (x / l) 
                                (if (setq l (vl-member-if 
                                              '(lambda (a) 
                                                 (apply        'xdrx_point_isinside 
                                                        (cons (car a) (car x)) 
                                                 ) 
                                               ) 
                                              tlst 
                                            ) 
                                    ) 
                                  (cons (cadr l) x) 
                                ) 
                              ) 
                             rlst 
                     ) 
                   ) 
      ) 
      (xdrx_entity_delete ss2) 
      (princ (car result)) 
    ) 
  ) 
  (princ) 
)

st788796 · 发表于 2014-12-30 16:55:45

本帖最后由 st788796 于 2014-12-30 16:57 编辑

直接在后面回复

加上排序, 再简单处理下就可以批量写到 xls 了

(defun c:tt (/ ss s1 s2 tlst plst ss1 ss2 lst rlst result)
(if (and (setq ss (ssget '((-4 . "<or")
(-4 . "<and")
(0 . "text")
(8 . "编号")
(-4 . "and>")
(-4 . "<and")
(0 . "line")
(8 . "L*")
(-4 . "and>")
(-4 . "or>")
)
)
)
(setq s1 (ssget "P"
'((0 . "text")
(8 . "编号")
)
)
)
(setq s2 (xdrx_pickset_subtract ss s1))
)
(progn
(setq tlst (mapcar '(lambda (x)
(xdrx_getpropertyvalue x "Position" "textstring")
)
(xdrx_pickset->ents s1)
)
tlst (vl-sort tlst
'(lambda (x1 x2)
(if (= (caar x1) (caar x2))
(> (cadar x1) (cadar x2))
(< (caar x1) (caar x2))
)
)
)
ss1 (xdrx_entity_transformedcopy s2 (xdrx_matrix_identity 3))
ss1 (xdrx_curve_intersectbreak ss1 0.1)
ss2 (xdrx_geom_searchRegions ss1 0)
lst (mapcar
'(lambda (x)
(xdrx_getpropertyvalue
x
"BoundingBox"
"Length"
"Area"
)
)
(xdrx_pickset->ents ss2)
)
rlst (cdr (vl-sort lst
'(lambda (x1 x2)
(> (last x1) (last x2))
)
)
)
rlst (vl-sort rlst
'(lambda (x1 x2)
(if (= (caaar x1) (caaar x2))
(> (cadaar x1) (cadaar x2))
(< (caaar x1) (caaar x2))
)
)
)
result (vl-remove
nil
(mapcar '(lambda (x / l)
(if (setq l (vl-member-if
'(lambda (a)
(apply 'xdrx_point_isinside
(cons (car a) (car x))
)
)
tlst
)
)
(cons (cadar l) x)
)
)
rlst
)
)
)
(xdrx_entity_delete ss2)
(setq result (mapcar
'(lambda (x)
(append
(cons
(distof (car (xdrx_string_split (car x) "-")))
(cons
(car x)
(mapcar '- (last (cadr x)) (caadr x))
)
)
(cddr x)
)
)
result
)
result (vl-sort result
'(lambda (x1 x2)
(< (car x1) (car x2))
)
)
result (mapcar 'cdr result)
)
(foreach x result
(princ "\n")
(princ x)
)
)
)
(princ)
)

(defun c:tt (/ ss s1 s2 tlst plst ss1 ss2 lst rlst result) 
  (if (and (setq ss (ssget '((-4 . "<or") 
                             (-4 . "<and") 
                             (0 . "text") 
                             (8 . "编号") 
                             (-4 . "and>") 
                             (-4 . "<and") 
                             (0 . "line") 
                             (8 . "L*") 
                             (-4 . "and>") 
                             (-4 . "or>") 
                            ) 
                    ) 
           ) 
           (setq s1 (ssget "P" 
                           '((0 . "text") 
                             (8 . "编号") 
                            ) 
                    ) 
           ) 
           (setq s2 (xdrx_pickset_subtract ss s1)) 
      ) 
    (progn 
      (setq tlst   (mapcar '(lambda (x) 
                              (xdrx_getpropertyvalue x "Position" "textstring") 
                            ) 
                           (xdrx_pickset->ents s1) 
                   ) 
            tlst   (vl-sort tlst 
                            '(lambda (x1 x2) 
                               (if (= (caar x1) (caar x2)) 
                                 (> (cadar x1) (cadar x2)) 
                                 (< (caar x1) (caar x2)) 
                               ) 
                             ) 
                   ) 
            ss1           (xdrx_entity_transformedcopy s2 (xdrx_matrix_identity 3)) 
            ss1           (xdrx_curve_intersectbreak ss1 0.1) 
            ss2           (xdrx_geom_searchRegions ss1 0) 
            lst           (mapcar 
                     '(lambda (x) 
                        (xdrx_getpropertyvalue 
                          x 
                          "BoundingBox" 
                          "Length" 
                          "Area" 
                        ) 
                      ) 
                     (xdrx_pickset->ents ss2) 
                   ) 
            rlst   (cdr        (vl-sort lst 
                                 '(lambda (x1 x2) 
                                    (> (last x1) (last x2)) 
                                  ) 
                        ) 
                   ) 
            rlst   (vl-sort rlst 
                            '(lambda (x1 x2) 
                               (if (= (caaar x1) (caaar x2)) 
                                 (> (cadaar x1) (cadaar x2)) 
                                 (< (caaar x1) (caaar x2)) 
                               ) 
                             ) 
                   ) 
            result (vl-remove 
                     nil 
                     (mapcar '(lambda (x / l) 
                                (if (setq l (vl-member-if 
                                              '(lambda (a) 
                                                 (apply        'xdrx_point_isinside 
                                                        (cons (car a) (car x)) 
                                                 ) 
                                               ) 
                                              tlst 
                                            ) 
                                    ) 
                                  (cons (cadar l) x) 
                                ) 
                              ) 
                             rlst 
                     ) 
                   ) 
      ) 
      (xdrx_entity_delete ss2) 
      (setq result (mapcar 
                     '(lambda (x) 
                        (append 
                          (cons 
                            (distof (car (xdrx_string_split (car x) "-"))) 
                            (cons 
                              (car x) 
                              (mapcar '- (last (cadr x)) (caadr x)) 
                            ) 
                          ) 
                          (cddr x) 
                        ) 
                      ) 
                     result 
                   ) 
            result (vl-sort result 
                            '(lambda (x1 x2) 
                               (< (car x1) (car x2)) 
                             ) 
                   ) 
            result (mapcar 'cdr result) 
      ) 
      (foreach x result 
        (princ "\n") 
        (princ x) 
      ) 
    ) 
  ) 
  (princ) 
)

部分结果
命令: tt
选择对象: 指定对角点: 找到 135 个
选择对象:
(1-1 0.0 550.0 0.0 2460.0 374000.0)
(1-2 0.0 550.0 0.0 2460.0 374000.0)
(1-3 0.0 550.0 0.0 2460.0 374000.0)
(1-4 0.0 550.0 0.0 2460.0 374000.0)
(1-5 0.0 550.0 0.0 2460.0 374000.0)
(1-6 0.0 550.0 0.0 2460.0 374000.0)
(1-7 0.0 550.0 0.0 2460.0 374000.0)
(1-8 0.0 550.0 0.0 2460.0 374000.0)
(1-9 0.0 550.0 0.0 2460.0 374000.0)
(1-10 0.0 550.0 0.0 2460.0 374000.0)
(2-1 0.0 550.0 0.0 2460.0 374000.0)
(2-2 0.0 550.0 0.0 2460.0 374000.0)
(2-3 0.0 550.0 0.0 2460.0 374000.0)
(2-4 0.0 550.0 0.0 2460.0 374000.0)
(2-5 0.0 550.0 0.0 2460.0 374000.0)
(2-6 0.0 550.0 0.0 2460.0 374000.0)
(2-7 0.0 550.0 0.0 2460.0 374000.0)
(2-8 0.0 550.0 0.0 2460.0 374000.0)
(2-9 0.0 550.0 0.0 2460.0 374000.0)
(2-10 0.0 550.0 0.0 2460.0 374000.0)

sicky111 · 发表于 2014-12-30 17:41:49

谢谢大侠，看演示像我需要的效果，但是我这边测试还是没有反应，是不是加载的文件不对？我测试的CAD是2007版，加载的是XDRx.2007.arx，XDRx.Init.2007.arx，xd-lisp-lib.VLX，XDRx.lsp，XDRx.x86.dll这几个文件，请指教！

st788796 · 发表于 2014-12-30 17:52:57

sicky111 发表于 2014-12-30 17:41
谢谢大侠，看演示像我需要的效果，但是我这边测试还是没有反应，是不是加载的文件不对？我测试的CAD是2007 ...

用到了新写的一个函数 xd::list: measure 仅写出了前 30 项

演示是 Windows 7 + autocad 2008

sicky111 · 发表于 2014-12-30 17:58:02

xd::list: measure这个函数在哪里可以找到，可以提供下吗？

sicky111 · 发表于 2014-12-30 18:06:54

大侠是不是先把EXCEL表格做成一个样板文件，用CAD获取list表，再把表中各项填入到样板文件中？当前表格只给出30行，如果数量超过30行，需要增加一个表格，页数1、页数2、页数3……

st788796 · 发表于 2014-12-30 18:30:04

sicky111 发表于 2014-12-30 18:06
大侠是不是先把EXCEL表格做成一个样板文件，用CAD获取list表，再把表中各项填入到样板文件中？当前表格只给 ...

正解，用模版写入区域是已知，只要按照这个区域构造list后一次写入即可

至于多页，可以用sheet，也可以用复制区域，给个行或列偏移，还是一样的list
，所用到的函数、方法最近的帖子都有介绍，综合起来就知道那些函数用途了

xd:: 函数都发布在开源函数库

Lispboy · 发表于 2014-12-30 19:25:17

sicky111 发表于 2014-12-30 17:58
xd::list: measure这个函数在哪里可以找到，可以提供下吗？

就在开源函数库论坛的首页呢

http://bbs.xdcad.net/thread-678698-1-1.html

bai2000 · 发表于 2014-12-30 21:10:19

能不能不要模板？

st788796 · 发表于 2014-12-30 21:43:41

bai2000 发表于 2014-12-30 21:10
能不能不要模板？

修改程序去适应模板而不是不要模板！

不要自己给自己加难度，改下 XLS 远比你在程序中计算省时省力！

819534890 · 发表于 2014-12-30 21:48:10

漂亮，学习一下

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

[求助] 按编号顺序将网格的周长面积输出到EXCEL表

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

相关帖子

评分

点评

点评

点评

评分

点评

评分

点评

点评

评分

点评