【已解决】怎样批量标注任意四边形边长和对角线并导出到EXCEL表格里

jiaoquangb · 发表于 2018-4-5 21:43:40

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

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

×

本帖最后由 jiaoquangb 于 2018-4-10 10:49 编辑

怎样批量标注任意四边形边长和对角线的长度并导出到EXCEL表格里？而且每个四边形要有编号，导出到EXCEL表格里的长度与编号是对应的
有大佬可以编写这样的程序吗？【已解决】

newer · 发表于 2018-4-5 21:55:48

搜索下论坛，论坛有。另外，如果有问题，请把问题做图，前后对比，截取图贴上来和上传测试的DWG，需要做EXCEL的，把自己做的EXCEL截图和上传XLS。

jiaoquangb · 发表于 2018-4-5 22:39:24

newer 发表于 2018-4-5 21:55
搜索下论坛，论坛有。另外，如果有问题，请把问题做图，前后对比，截取图贴上来和上传测试的DWG，需要做EXC ...

我搜索了，论坛有这个帖子，但没有程序代码

newer · 发表于 2018-4-5 22:51:31

jiaoquangb 发表于 2018-4-5 22:39
我搜索了，论坛有这个帖子，但没有程序代码

不只一个，有很多，换换关键字。

jiaoquangb · 发表于 2018-4-5 22:55:20

newer 发表于 2018-4-5 21:55
搜索下论坛，论坛有。另外，如果有问题，请把问题做图，前后对比，截取图贴上来和上传测试的DWG，需要做EXC ...

下面是原图：

下面是结果图和结果表格：
结果图.png

请点击此处下载

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

您的用户组是：游客

文件名称:原图CAD.zip
下载次数:40 文件大小:30.11 KB
下载权限: 不限以上 [免费赚D豆]

请点击此处下载

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

您的用户组是：游客

文件名称:结果图和表格.zip
下载次数:33 文件大小:57.25 KB
下载权限: 不限以上 [免费赚D豆]

jiaoquangb · 发表于 2018-4-5 22:57:04

newer 发表于 2018-4-5 22:51
不只一个，有很多，换换关键字。

我是使用“四边形”关键词搜索的，搜索不到程序

newer · 发表于 2018-4-5 23:30:51

本帖最后由 newer 于 2018-4-5 23:33 编辑

jiaoquangb 发表于 2018-4-5 22:57
我是使用“四边形”关键词搜索的，搜索不到程序

换对角线或多段线长度试试

jiaoquangb · 发表于 2018-4-5 23:40:07

newer 发表于 2018-4-5 23:30
换对角线或多段线长度试试

老师，还是搜索不到。您可以编写批量标注任意四边形边长和对角线的长度并编号再导出到EXCEL表格里吗？

newer · 发表于 2018-4-6 17:48:41

本帖最后由 newer 于 2018-4-8 13:46 编辑

jiaoquangb 发表于 2018-4-5 23:40
老师，还是搜索不到。您可以编写批量标注任意四边形边长和对角线的长度并编号再导出到EXCEL表格里吗？

试试，你这是什么专业？标注的是什么？玻璃？

对角线标注-制表.gif

函数 XD::Polyline:ResetStartpoint 见：http://bbs.xdcad.net/thread-705961-1-1.html

(defun c:tt ()
(defun XD::Polyline:ResetSTartPoint (ent pnt / e1 ss typ pl pts)
(if (= (type ent) 'LIST)
(progn (setq pl (xdrx_polyline_make ent))
(xdrx_setpropertyvalue pl "closed" t)
(setq ent pl)
)
)
(if (xdrx_getpropertyvalue ent "isClosed")
(progn
(setq typ (xdrx_object_classname ent))
(if (= "POLYLINE" (car typ))
(setq ent (xdrx_polyline_convertfrom ent))
)
(if
(and
(xdrx_point_ison pnt ent)
(not
(equal pnt (xdrx_getpropertyvalue ent "startpoint") 1e-3)
)
)
(progn (xdrx_entity_copy ent)
(setq e1 (entlast))
(setq ss (xdrx_curve_getsplitcurves e1 pnt))
(xdrx_curve->polyline (entlast) e1)
(xdrx_entity_matchprop ent (entlast))
(xdrx_object_swapid ent (entlast))
(xdrx_entity_delete (entlast))
)
)
)
)
(if pl
(progn (setq pts (xdrx_getpropertyvalue ent "vertices"))
(xdrx_entity_delete ent)
pts
)
ent
)
)
(defun _collect (x)
(if (not (xdrx_curve_direction x))
(xdrx_curve_reverse x)
)
(setq verts (xdrx_getpropertyvalue x "vertices")
verts (xd::list:removetail verts)
)
(if (= 4 (length verts))
(progn (setq p1 (xd::pnts:extremum verts '< '< t))
(setq verts (xd::polyline:resetstartpoint verts p1)
verts (xd::list:removetail verts)
centroid (xdrx_points_centroid verts)
p1 (nth 0 verts)
p2 (nth 1 verts)
p3 (nth 2 verts)
p4 (nth 3 verts)
v (mapcar '- p3 p4)
xdir (mapcar '- (xdrx_midp p3 p4) centroid)
xdir (xdrx_vector_normalize xdir)
p2 (XD::Pnts:Project
(list centroid)
p3
p4
xdir
)
p2 (car p2)
centroid1 (xdrx_midp p2 centroid)
p2 (XD::Pnts:Project
(list centroid)
p1
p4
(xdrx_vector_perpvector xdir)
)
centroid2 (xdrx_midp (car p2) centroid)
)
(setq lst (xd::list:snakepair (xd::pnts:close verts))
lst (list (nth 0 lst) (nth 2 lst) (nth 3 lst) (nth 1 lst))
lst (append lst (list (list (car verts) (nth 2 verts))))
lst (append lst (list (list (nth 1 verts) (last verts))))
)
)
)
)
(defun _dim (lst)
(XD::DIM:Init) ;;注释掉，使用自己设置的当前标注样式,或者修改标注样式XD-DM-XXXX的全局比例符合要求。
(setq dim_ents nil)
(mapcar '(lambda (x)
(setq p1 (car x)
p2 (cadr x)
v (mapcar '- p2 p1)
v (xdrx_vector_normalize v)
v (xdrx_vector_perpvector v)
v (xdrx_vector_negate v)
p3 (xdrx_midp p1 p2)
p3 (mapcar '+
p3
(xdrx_vector_product v #xd_var_global_dim_offset)
)
)
(xdrx_dimension_makerotate
(car x)
(cadr x)
p3
(angle p1 p2)
)
(xdrx_setpropertyvalue (entlast) "color" 4)
(setq dim_ents (cons (entlast) dim_ents))
)
lst
)
)
(defun _tongji (lst)
(setq
lst1 (mapcar '(lambda (x) (rtos (apply 'distance x) 2 1)) lst)
)
(setq
lst1 (append
(list (itoa (setq no (1+ no)))
(setq txt (strcat "A-" (itoa no)))
)
lst1
)
)
(xdrx_text_make centroid1 txt #xd_var_global_bianhaoheight)
(XD::Text:SetAlignment (entlast) centroid1 "M")
(xdrx_setpropertyvalue (entlast) "color" 1)
(setq box1 (xdrx_entity_box (entlast))
box2 (mapcar '(lambda (x)
(setq ecs (xdrx_entity_getecs x))
(xdrx_entity_box x (cadr ecs))
)
(list (car dim_ents) (cadr dim_ents))
)
)
(if (vl-some '(lambda (x)
(or (xdrx_points_boundingboxintersectwith box1 x)
(xdrx_curve_isinside x box1)
)
)
box2
)
(progn
(XD::Text:SetAlignment (entlast) centroid2 "M")
)
)
lst1
)
(defun _drawtable (data)
(xd::text:init 1)
(if (setq pt (getpoint "\n表格插入点:"))
(progn (xd::text:init 1)
(XD::Table:MakeFromList
data
pt
#xd_var_global_textheight
(/ #xd_var_global_textheight 2.0)
)
)
)
)
(xdrx_begin)
(if (not #xd_var_global_textheight)
(setq #xd_var_global_textheight 3.5) ;表格默认的文字高度
)
(if (setq
var (getreal
(xdrx_prompt "\n字高<" #xd_var_global_textheight ">:" t)
)
)
(setq #xd_var_global_textheight var)
)
(if (not #xd_var_global_dim_offset)
(setq #xd_var_global_dim_offset 15.0) ;尺寸线偏移默认值
)
(if (setq
var (getreal
(xdrx_prompt "\n尺寸线偏移距离<" #xd_var_global_dim_offset ">:" t)
)
)
(setq #xd_var_global_dim_offset var)
)
(setq #xd_var_global_bianhaoheight (* #xd_var_global_textheight 1.2));编号高度和表格文字高度的比值1.2
(if (and (xdrx_initssget "选择封闭的四边形<退出>:")
(setq ss (xdrx_ssget '((0 . "*POLYLINE") (-4 . "&=") (70 . 1))))
)
(progn (xdrx_polyline_compress ss)
(setq box (xdrx_entity_box (ssname ss 0)))
(xdrx_document_setprec
(list (distance (car box) (last box)) 1.0)
)
(setq ss (xd::pickset:tablesort ss 0 2 '> '<))
(setq no 0
data nil
)
(mapcar '(lambda (x)
(setq lst (_collect x))
(_dim lst)
(setq data (cons (_tongji lst) data))
)
(xd::list:flat ss)
)
(setq data (cons (list "四边形长度统计表" "" "" "" "" "" "" "")
(cons (list "序号" "编号"
"底边" "上边"
"左边" "右边"
"对角线1" "对角线2"
)
(reverse data)
)
)
)
(_drawtable data)
)
)
(xdrx_end)
(princ)
)

(defun c:tt () 
  (defun XD::Polyline:ResetSTartPoint (ent pnt / e1 ss typ pl pts) 
    (if        (= (type ent) 'LIST) 
      (progn (setq pl (xdrx_polyline_make ent)) 
             (xdrx_setpropertyvalue pl "closed" t) 
             (setq ent pl) 
      ) 
    ) 
    (if        (xdrx_getpropertyvalue ent "isClosed") 
      (progn 
        (setq typ (xdrx_object_classname ent)) 
        (if (= "POLYLINE" (car typ)) 
          (setq ent (xdrx_polyline_convertfrom ent)) 
        ) 
        (if 
          (and 
            (xdrx_point_ison pnt ent) 
            (not 
              (equal pnt (xdrx_getpropertyvalue ent "startpoint") 1e-3) 
            ) 
          ) 
           (progn (xdrx_entity_copy ent) 
                  (setq e1 (entlast)) 
                  (setq ss (xdrx_curve_getsplitcurves e1 pnt)) 
                  (xdrx_curve->polyline (entlast) e1) 
                  (xdrx_entity_matchprop ent (entlast)) 
                  (xdrx_object_swapid ent (entlast)) 
                  (xdrx_entity_delete (entlast)) 
           ) 
        ) 
      ) 
    ) 
    (if        pl 
      (progn (setq pts (xdrx_getpropertyvalue ent "vertices")) 
             (xdrx_entity_delete ent) 
             pts 
      ) 
      ent 
    ) 
  ) 
  (defun _collect (x) 
    (if        (not (xdrx_curve_direction x)) 
      (xdrx_curve_reverse x) 
    ) 
    (setq verts        (xdrx_getpropertyvalue x "vertices") 
          verts        (xd::list:removetail verts) 
    ) 
    (if        (= 4 (length verts)) 
      (progn (setq p1 (xd::pnts:extremum verts '< '< t)) 
             (setq verts     (xd::polyline:resetstartpoint verts p1) 
                   verts     (xd::list:removetail verts) 
                   centroid  (xdrx_points_centroid verts) 
                   p1             (nth 0 verts) 
                   p2             (nth 1 verts) 
                   p3             (nth 2 verts) 
                   p4             (nth 3 verts) 
                   v             (mapcar '- p3 p4) 
                   xdir             (mapcar '- (xdrx_midp p3 p4) centroid) 
                   xdir             (xdrx_vector_normalize xdir) 
                   p2             (XD::Pnts:Project 
                               (list centroid) 
                               p3 
                               p4 
                               xdir 
                             ) 
                   p2             (car p2) 
                   centroid1 (xdrx_midp p2 centroid) 
                   p2             (XD::Pnts:Project 
                               (list centroid) 
                               p1 
                               p4 
                               (xdrx_vector_perpvector xdir) 
                             ) 
                   centroid2 (xdrx_midp (car p2) centroid) 
             ) 
             (setq lst (xd::list:snakepair (xd::pnts:close verts)) 
                   lst (list (nth 0 lst) (nth 2 lst) (nth 3 lst) (nth 1 lst)) 
                   lst (append lst (list (list (car verts) (nth 2 verts)))) 
                   lst (append lst (list (list (nth 1 verts) (last verts)))) 
             ) 
      ) 
    ) 
  ) 
  (defun _dim (lst) 
    (XD::DIM:Init) ;;注释掉，使用自己设置的当前标注样式,或者修改标注样式XD-DM-XXXX的全局比例符合要求。 
    (setq dim_ents nil) 
    (mapcar '(lambda (x) 
               (setq p1        (car x) 
                     p2        (cadr x) 
                     v        (mapcar '- p2 p1) 
                     v        (xdrx_vector_normalize v) 
                     v        (xdrx_vector_perpvector v) 
                     v        (xdrx_vector_negate v) 
                     p3        (xdrx_midp p1 p2) 
                     p3        (mapcar        '+ 
                                p3 
                                (xdrx_vector_product v #xd_var_global_dim_offset) 
                        ) 
               ) 
               (xdrx_dimension_makerotate 
                 (car x) 
                 (cadr x) 
                 p3 
                 (angle p1 p2) 
               ) 
               (xdrx_setpropertyvalue (entlast) "color" 4) 
               (setq dim_ents (cons (entlast) dim_ents)) 
             ) 
            lst 
    ) 
  ) 
  (defun _tongji (lst) 
    (setq 
      lst1 (mapcar '(lambda (x) (rtos (apply 'distance x) 2 1)) lst) 
    ) 
    (setq 
      lst1 (append 
             (list (itoa (setq no (1+ no))) 
                   (setq txt (strcat "A-" (itoa no))) 
             ) 
             lst1 
           ) 
    ) 
    (xdrx_text_make centroid1 txt #xd_var_global_bianhaoheight) 
    (XD::Text:SetAlignment (entlast) centroid1 "M") 
    (xdrx_setpropertyvalue (entlast) "color" 1) 
    (setq box1 (xdrx_entity_box (entlast)) 
          box2 (mapcar '(lambda        (x) 
                          (setq ecs (xdrx_entity_getecs x)) 
                          (xdrx_entity_box x (cadr ecs)) 
                        ) 
                       (list (car dim_ents) (cadr dim_ents)) 
               ) 
    ) 
    (if        (vl-some '(lambda (x) 
                    (or        (xdrx_points_boundingboxintersectwith box1 x) 
                        (xdrx_curve_isinside x box1) 
                    ) 
                  ) 
                 box2 
        ) 
      (progn 
        (XD::Text:SetAlignment (entlast) centroid2 "M") 
      ) 
    ) 
    lst1 
  ) 
  (defun _drawtable (data) 
    (xd::text:init 1) 
    (if        (setq pt (getpoint "\n表格插入点:")) 
      (progn (xd::text:init 1) 
             (XD::Table:MakeFromList 
               data 
               pt 
               #xd_var_global_textheight 
               (/ #xd_var_global_textheight 2.0) 
             ) 
      ) 
    ) 
  ) 
  (xdrx_begin) 
  (if (not #xd_var_global_textheight) 
    (setq #xd_var_global_textheight 3.5) ;表格默认的文字高度 
  ) 
  (if (setq 
        var (getreal 
              (xdrx_prompt "\n字高<" #xd_var_global_textheight ">:" t) 
            ) 
      ) 
    (setq #xd_var_global_textheight var) 
  ) 
  (if (not #xd_var_global_dim_offset) 
    (setq #xd_var_global_dim_offset 15.0) ;尺寸线偏移默认值 
  ) 
  (if (setq 
        var (getreal 
              (xdrx_prompt "\n尺寸线偏移距离<" #xd_var_global_dim_offset ">:" t) 
            ) 
      ) 
    (setq #xd_var_global_dim_offset var) 
  ) 
  (setq #xd_var_global_bianhaoheight (* #xd_var_global_textheight 1.2));编号高度和表格文字高度的比值1.2 
  (if (and (xdrx_initssget "选择封闭的四边形<退出>:") 
           (setq ss (xdrx_ssget '((0 . "*POLYLINE") (-4 . "&=") (70 . 1)))) 
      ) 
    (progn (xdrx_polyline_compress ss) 
           (setq box (xdrx_entity_box (ssname ss 0))) 
           (xdrx_document_setprec 
             (list (distance (car box) (last box)) 1.0) 
           ) 
           (setq ss (xd::pickset:tablesort ss 0 2 '> '<)) 
           (setq no   0 
                 data nil 
           ) 
           (mapcar '(lambda (x) 
                      (setq lst (_collect x)) 
                      (_dim lst) 
                      (setq data (cons (_tongji lst) data)) 
                    ) 
                   (xd::list:flat ss) 
           ) 
           (setq data (cons (list "四边形长度统计表" "" "" "" "" "" "" "") 
                            (cons (list        "序 号"            "编 号" 
                                        "底 边"            "上 边" 
                                        "左 边"            "右 边" 
                                        "对角线1"   "对角线2" 
                                       ) 
                                  (reverse data) 
                            ) 
                      ) 
           ) 
           (_drawtable data) 
    ) 
  ) 
  (xdrx_end) 
  (princ) 
)

jiaoquangb · 发表于 2018-4-6 21:22:00

newer 发表于 2018-4-6 17:48
试试，你这是什么专业？标注的是什么？玻璃？

老师，怎么是错误的？您说的函数 XD::Polyline:ResetStartpoint 要放在哪里？另外，CAD里的表格可以导出到EXCEL表格里吗？
QQ图片20180406211908.png

newer · 发表于 2018-4-6 21:31:11

jiaoquangb 发表于 2018-4-6 21:22
老师，怎么是错误的？您说的函数 XD::Polyline:ResetStartpoint 要放在哪里？另外，CAD里的表格可以导出 ...

你也不是第一个求助程序了，加载XDRX API 或者安装晓东工具箱。

那个函数，你拷贝到上面代码之后一起加载就行。

jiaoquangb · 发表于 2018-4-6 21:38:28

newer 发表于 2018-4-6 21:31
你也不是第一个求助程序了，加载XDRX API 或者安装晓东工具箱。

那个函数，你拷贝到上面代码之后一起 ...

我加载XDRX API 了，另外，CAD里的表格可以导出到EXCEL表格里吗？

jiaoquangb · 发表于 2018-4-6 22:04:48

newer 发表于 2018-4-6 21:31
你也不是第一个求助程序了，加载XDRX API 或者安装晓东工具箱。

那个函数，你拷贝到上面代码之后一起 ...

我下载最新的XDRX API就行了，老师，XDRX API有时间限制吗？XDRX API过期了就不能使用了吗？
另外，CAD里生成的表格可以导出到EXCEL表格里吗？

jiaoquangb · 发表于 2018-4-6 22:14:06

newer 发表于 2018-4-6 21:31
你也不是第一个求助程序了，加载XDRX API 或者安装晓东工具箱。

那个函数，你拷贝到上面代码之后一起 ...

老师，我给你一个原图测试，怎么有两个编号跑到图形外面去了呀？

请点击此处下载

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

您的用户组是：游客

文件名称:测试原图.zip
下载次数:3 文件大小:19.58 KB
下载权限: 不限以上 [免费赚D豆]

newer · 发表于 2018-4-6 22:17:27

本帖最后由 newer 于 2018-4-6 22:20 编辑

jiaoquangb 发表于 2018-4-6 22:04
我下载最新的XDRX API就行了，老师，XDRX API有时间限制吗？XDRX API过期了就不能使用了吗？
另外，CAD ...

仔细去看API的下载页面的说明，或者，你自己把时间改到 2099年，然后你加载看看。
CAD表格到EXCEL转换，论坛有插件，晓东工具箱表格菜单里面也有。

搜狗截图20180406222106.gif

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

[已解决] 【已解决】怎样批量标注任意四边形边长和对角线并导出到EXCEL表格里

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

点评

点评

点评

点评

点评

点评

点评

点评

点评

点评

点评