普通线、文字画的表格转出到EXCEL

XDSoft · 发表于 2018-9-2 22:01:52

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

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

×

将普通LINE，POLYLINE，和文字实体画的表格，转出到EXCEL里面请在2018.09.02日以后更新的API下执行。

(defun c:xdtb_ln->excel (/ #textheight #textstyle
box e fuzz i info
j ss ss1 tbl temp
tf txts x y
)
(xd::begin)
(setq tf t)
(while
(and tf
(setq fn (xdrx_system_selectFiles
(if (not tf1)
"选择保存的文件"
"文件在使用，重新选择保存的文件"
)
""
"xlsx"
1
)
)
(setq fn (car fn))
(progn (if (setq tf1 (xdrx_system_fileInUse fn))
(xdrx_prompt "\n\n文件已经使用，请关闭或者重新命名.")
(setq tf nil)
)
t
)
)
)
(if (and (not tf)
(setq fuzz (getdist "\n输入精度<退出>:"))
(xdrx_initssget "\n选择表格线(LINE,*POLYLINE)<退出>:")
(setq ss (xdrx_ssget '((0 . "line,*polyline"))))
(setq ss (xdrx_entity_copy ss))
(setq box (xdrx_entity_box ss))
(xdrx_polyline_make (xd::pnts:ucs2wcs box) t)
(ssadd (entlast) ss)
(setq ents (xdrx_pickset->ents ss))
(xdrx_runtime t)
(progn (setq tf (xd::doc:safezoom ss)) t)
(setq info (xd::table<-lines ss (abs fuzz)))
)
(progn
(setq merges (nth 5 info))
(xdrx_begin)
(setq num 0
lst1 nil
)
(mapcar
'(lambda (x)
(setq num (1+ num))
(if (= (logand num 5) 0)
(progn (princ (xdrx_prompt "\r正在处理 " num t)))
)
(if
(and x (setq temp (ssget "cp" (nth 2 x) '((0 . "*text")))))
(progn (setq i (nth 0 x)
j (nth 1 x)
)
(setq ss1 (XD::Pickset:TableSort temp 0 3 '> '<)
txts (xdrx_string_join
(mapcar
'(lambda (x)
(apply 'strcat
(mapcar '(lambda (y)
(xdrx_getpropertyvalue
y
"textstring"
)
)
x
)
)
)
ss1
)
"\r\n"
)
)
(setq lst1 (cons (list i j txts) lst1))
)
)
)
(apply 'append (nth 6 info))
)
(setq lst1 (reverse lst1))
(xdrx_entity_delete ents)
(and tf (xdrx_document_zoomprevious))
(xdrx_prompt "\n执行时间:" (xdrx_runtime) "s.")
(if (xd::list->excel lst1 merges fn)
(progn (xdrx_prompt "\nEXCEL文件导出成功.")
(xdrx_initget "Y N")
(if (= 1 (xdrx_yesorno "\n是否打开EXCEL文件" 0))
(xdrx_system_shellExecute fn)
)
)
)
)
)
(xdrx_end)
(princ)
)

(defun c:xdtb_ln->excel        (/         #textheight         #textstyle 
                         box         e         fuzz         i         info 
                         j         ss         ss1         tbl         temp 
                         tf         txts         x         y 
                        ) 
  (xd::begin) 
  (setq tf t) 
  (while 
    (and tf 
         (setq fn (xdrx_system_selectFiles 
                    (if        (not tf1) 
                      "选择保存的文件" 
                      "文件在使用，重新选择保存的文件" 
                    ) 
                    "" 
                    "xlsx" 
                    1 
                  ) 
         ) 
         (setq fn (car fn)) 
         (progn        (if (setq tf1 (xdrx_system_fileInUse fn)) 
                  (xdrx_prompt "\n\n文件已经使用，请关闭或者重新命名.") 
                  (setq tf nil) 
                ) 
                t 
         ) 
    ) 
  ) 
  (if (and (not tf) 
           (setq fuzz (getdist "\n输入精度<退出>:")) 
           (xdrx_initssget "\n选择表格线(LINE,*POLYLINE)<退出>:") 
           (setq ss (xdrx_ssget '((0 . "line,*polyline")))) 
           (setq ss (xdrx_entity_copy ss)) 
           (setq box (xdrx_entity_box ss)) 
           (xdrx_polyline_make (xd::pnts:ucs2wcs box) t) 
           (ssadd (entlast) ss) 
           (setq ents (xdrx_pickset->ents ss)) 
           (xdrx_runtime t) 
           (progn (setq tf (xd::doc:safezoom ss)) t) 
           (setq info (xd::table<-lines ss (abs fuzz))) 
      ) 
    (progn 
      (setq merges (nth 5 info)) 
      (xdrx_begin) 
      (setq num         0 
            lst1 nil 
      ) 
      (mapcar 
        '(lambda (x) 
           (setq num (1+ num)) 
           (if (= (logand num 5) 0) 
             (progn (princ (xdrx_prompt "\r正在处理 " num t))) 
           ) 
           (if 
             (and x (setq temp (ssget "cp" (nth 2 x) '((0 . "*text"))))) 
              (progn (setq i (nth 0 x) 
                           j (nth 1 x) 
                     ) 
                     (setq ss1        (XD::Pickset:TableSort temp 0 3 '> '<) 
                           txts        (xdrx_string_join 
                                  (mapcar 
                                    '(lambda (x) 
                                       (apply 'strcat 
                                              (mapcar '(lambda (y) 
                                                         (xdrx_getpropertyvalue 
                                                           y 
                                                           "textstring" 
                                                         ) 
                                                       ) 
                                                      x 
                                              ) 
                                       ) 
                                     ) 
                                    ss1 
                                  ) 
                                  "\r\n" 
                                ) 
                     ) 
                     (setq lst1 (cons (list i j txts) lst1)) 
              ) 
           ) 
         ) 
        (apply 'append (nth 6 info)) 
      ) 
      (setq lst1 (reverse lst1)) 
      (xdrx_entity_delete ents) 
      (and tf (xdrx_document_zoomprevious)) 
      (xdrx_prompt "\n执行时间:" (xdrx_runtime) "s.") 
      (if (xd::list->excel lst1 merges fn) 
        (progn (xdrx_prompt "\nEXCEL文件导出成功.") 
               (xdrx_initget "Y N") 
               (if (= 1 (xdrx_yesorno "\n是否打开EXCEL文件" 0)) 
                 (xdrx_system_shellExecute fn) 
               ) 
        ) 
      ) 
    ) 
  ) 
  (xdrx_end) 
  (princ) 
)

lw5297590 · 发表于 2018-9-3 08:52:57

感谢分享，下载试一下新功能

myairen · 发表于 2018-9-3 09:08:59

双击击击击击击击击击击击击击击击击击击击击击击击击击击击击击击击击

cfc123456 · 发表于 2018-9-3 11:38:22

普通线、文字画的表格转出到EXCEL

hejiho · 发表于 2018-9-3 13:05:07

哇，好强大，感激不尽！

renyonghua2014 · 发表于 2018-9-4 11:57:34

这个好实用，谢楼主。

WZY5357 · 发表于 2018-12-1 17:29:44

这个工具很好，谢谢楼主

kqqt6236 · 发表于 2018-12-3 09:07:42

这个功能厉害了。

kiwiairui · 发表于 2018-12-3 09:45:28

谢谢分享

wacy1902 · 发表于 2018-12-3 15:33:28

请问下精度是要怎么设置呢？

w18089326749 · 发表于 2018-12-3 16:07:29

这个可以的
来自: 微社区

WZY5357 · 发表于 2018-12-6 15:31:37

好东西有用

czm980251042 · 发表于 2019-12-17 11:00:32

求问一下大神，出现这种情况是怎么回事？
附上文件，大神可以看看

请点击此处下载

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

您的用户组是：游客

文件名称:绿化设计总平面图1 - 副本.zip
下载次数:0 文件大小:234.84 KB
下载权限: 不限以上 [免费赚D豆]

听雨轩_D9JPw · 发表于 2019-12-29 16:29:47

老师用不了 CAD软件卡死

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

[表格] 普通线、文字画的表格转出到EXCEL

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