设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 2018|回复: 22

[表格] excel table Autoca普通文字表格 互转

[复制链接]

已领礼包: 604个

财富等级: 财运亨通

发表于 2017-10-16 10:34:09 | 显示全部楼层 |阅读模式

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

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

x
本帖最后由 /db_自贡黄明儒_ 于 2017-10-20 09:16 编辑

众所周知,excel具有强大易用的统计功能,现在高版本的cad的table也起来起象excel了。excel table Autoca普通文字表格 ,三者互转就很有用。
许多人对此都有研究,如G版。
下面是我收集的
truetable是破解版,供学习研究用,为尊重作者劳动成果,希望用后删除。不过你可以使用下面8楼我用lisp编写的,没有版本限制,不过照样收费
tt.png

truetable10.0A含破解.rar

1.55 MB, 下载次数: 174, 下载积分: D豆 -1 , 活跃度 1

评分

参与人数 1D豆 +10 收起 理由
yufeng37 + 10 很给力!经验;技术要点;资料分享奖!

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 604个

财富等级: 财运亨通

 楼主| 发表于 2017-10-16 10:37:23 | 显示全部楼层
本帖最后由 /db_自贡黄明儒_ 于 2017-10-18 13:24 编辑

此外,我还收集了其它版本

报表转绘王(excel转cad最完美的工具)V20160815最新版@200_111289.rar

518.05 KB, 下载次数: 126, 下载积分: D豆 -1 , 活跃度 1

CAD辅助 表格转Excel工具.rar

445.46 KB, 下载次数: 100, 下载积分: D豆 -1 , 活跃度 1

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

 楼主| 发表于 2017-10-16 10:39:15 | 显示全部楼层
本帖最后由 /db_自贡黄明儒_ 于 2017-10-18 13:29 编辑

我还收集了其它版本

cad表格转excel_207@68168.part1.rar

1.9 MB, 下载次数: 50, 下载积分: D豆 -1 , 活跃度 1

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

 楼主| 发表于 2017-10-16 11:11:57 | 显示全部楼层
本帖最后由 /db_自贡黄明儒_ 于 2017-10-18 13:30 编辑

接楼上              

cad表格转excel_207@68168.part2.rar

1.14 MB, 下载次数: 45, 下载积分: D豆 -1 , 活跃度 1

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

 楼主| 发表于 2017-10-16 11:14:33 | 显示全部楼层
也有lisp版本的,
  1. ;;; 提取cad表格到excel中的程序,功能比较简单,效率比较低
  2. ;;; by qjchen@gmail.com
  3. ;;; 练练手而已,功能比较弱,建议大家用truetable:)
  4. ;;; 要求r2000以上,要求所有的文本在格子中,每个格子只有一个文本,文本可在格
  5. ;;; 子内任何位置,要求非常规则的表格,表格从上到下的列数都一致
  6. ;;; 所以选择的时候最好不要选择标题栏




  7. (defun c:qjchenb2e ( / column finallist i j outlist p1 p3 palist palllist phlist pvlist row rowlist ss x)
  8.   (setvar "osmode" 33)
  9.   (setq p1 (getpoint "\n左上角点:")
  10.         p3 (getpoint "\n右下角点:")
  11. pvlist (vl-Get-Int-Pt (polar p1 0 1) (polar (list (car p1) (car (cdr p3)) 0) 0 1))
  12. pvlist (mapcar '(lambda (x) (polar x pi 1)) pvlist)
  13.         phlist (vl-Get-Int-Pt (polar p1 (* pi 1.5) 1) (polar (list (car p3) (car (cdr p1)) 0) pi 1))
  14.         palllist (list pvlist)
  15.         i 1)
  16.   (repeat (- (length phlist) 1)
  17.     (setq palllist (append palllist (list (mapcar '(lambda (x)(list (car (nth i phlist)) (car (cdr x))(car (cddr x)))) pvlist)))
  18.           i (1+ i))
  19.   )
  20.   (setq column (length palllist) row (length (nth 0 palllist)) j 0 finallist nil)
  21.   (setvar "osmode" 0)
  22.   (repeat (- row 1)
  23.     (setq i 0 rowlist nil)
  24.     (repeat (- column 1)
  25.       (setq palist (list (nth j (nth i palllist))
  26.       (nth (1+ j) (nth i palllist))
  27.       (nth (1+ j) (nth (1+ i) palllist))
  28.       (nth j (nth (1+ i) palllist))))
  29.      (SETQ SS (SSGET "WP" palist))
  30.       (if (/= ss nil)
  31. (setq rowlist (append rowlist (list (cdr (assoc 1 (ENTGET (SSNAME SS 0)))))))
  32.           (setq rowlist (append rowlist (list " ")))
  33.       )
  34.       (setq i (1+ i))
  35.     )
  36.     (setq finallist (append finallist (list rowlist)) j (1+ j))
  37.   )      
  38.   (setq outlist finallist)
  39.         
  40.   (2xl outlist)
  41. )




  42. ;;; 引用一个韩国朋友写的关于两点和多个物体交点的程序
  43. (defun vl-Get-Int-Pt (FirstPoint SecondPoint / acadDocument mSpace SSetName
  44. SSets SSet reapp ex obj Baseline
  45.     )
  46.   (vl-load-com)
  47.   (setq acadDocument (vla-get-ActiveDocument (vlax-get-acad-object)))
  48.   (setq mSpace (vla-get-ModelSpace acadDocument))
  49.   (setq SSetName "MySSet")
  50.   (setq SSets (vla-get-SelectionSets acadDocument))
  51.   (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-add (list SSets SSetName )))
  52.     (vla-clear (vla-Item SSets SSetName))
  53.   )
  54.   (setq SSet (vla-Item SSets SSetName))
  55.   (setq Baseline (vla-Addline mspace (vlax-3d-point FirstPoint)(vlax-3d-point SecondPoint)))
  56.   (vla-SelectByPolygon SSet acSelectionSetFence
  57.       (kht:list->safearray (append FirstPoint SecondPoint) 'vlax-vbdouble))
  58.   (vlax-for obj sset (if (setq ex (kht-intersect (vlax-vla-object->ename BaseLine)(vlax-vla-object->ename obj)))
  59.       (setq reapp (append reapp ex))
  60.     )
  61.   )
  62.   (vla-delete BaseLine)
  63.   (setq reapp (vl-sort reapp '(lambda (e1 e2) (< (car e1) (car e2)))))
  64.   reapp
  65. )




  66. ;;; 修改了一点,让text和其他的没有交点
  67. (defun kht-intersect (en1 en2 / a b x ex ex-app c d e)
  68.   (vl-load-com)
  69.   (setq c (cdr (assoc 0 (entget en1)))
  70. d (cdr (assoc 0 (entget en2)))
  71.   )
  72.   (if (or (= c "TEXT") (= d "TEXT") )
  73.     (setq e -1)
  74.   )
  75.   (setq En1 (vlax-ename->vla-object En1))
  76.   (setq En2 (vlax-ename->vla-object En2))
  77.   (setq a (vla-intersectwith en1 en2 acExtendNone))
  78.   (setq a (vlax-variant-value a))
  79.   (setq b (vlax-safearray-get-u-bound a 1))
  80.   (if (= e -1) (setq b e) )
  81.   (if (/= b -1)
  82.     (progn
  83.       (setq a (vlax-safearray->list a))
  84.       (repeat (/ (length a) 3)
  85. (setq ex-app (append ex-app (list (list (car a) (cadr a) (caddr a))))
  86.      a (cdr (cdr (cdr a))))
  87.       )
  88.       ex-app
  89.     )
  90.     nil
  91.   )
  92. )


  93. (defun kht:list->safearray (lst datatype)
  94.   (vlax-safearray-fill (vlax-make-safearray (eval datatype) (cons 0 (1- (length lst)))) lst)
  95. )


  96. (defun TerminaExcel ()
  97.   (vlax-release-object *cells*)
  98.   (vlax-release-object *item*)
  99.   (vlax-release-object *workbooks*)
  100.   (vlax-release-object *Excel*)
  101. )




  102. (defun IniciaExcel (/ m)
  103.   (vl-load-com)
  104.   (setq m (vlax-get-or-create-object "excel.application"))
  105.   (if (= (vla-get-visible m) :Vlax-false)
  106.     (vla-put-visible (vlax-get-or-create-object "excel.application") T)
  107.   )
  108.   (setq *Excel* (vlax-get-or-create-object "excel.application"))
  109.   (if (= (vlax-get-property *Excel* "activeworkbook") nil)
  110.     (progn
  111.       (setq *workbooks* (vlax-get-property *Excel* "workbooks"))
  112.       (vlax-invoke-method *workbooks* "add")
  113.       (setq deltaRow nil)
  114.     )
  115.   )
  116.   (setq *workbooks* (vlax-get-property *Excel* "activeworkbook")
  117. *item* (vlax-get-property *workbooks* "activesheet");        *item*           (vlax-get-property *sheets* "item" 1)
  118. *cells* (vlax-get-property *item* "cells")
  119.   )
  120.   (if (= (vlax-get-object "Excel.Application") nil)
  121.     (progn
  122.       (vla-put-visible *Excel* T)
  123.     )
  124.   )
  125. )


  126. (defun 2xl (outlist / temp val cll rll cel ccel ccell curid curval curcell)
  127. (IniciaExcel)
  128. (setq list1 (conexcelcolumn) curRow 1)
  129. (if (= deltaRow nil) (setq deltaRow 0))
  130. (repeat (length outList)
  131.     (setq temp 1)
  132.     (repeat (length (nth 0 outlist))
  133.      (setq val (nth (1- temp) (nth (- curRow 1) outList)))
  134.      (setq cll (nth temp list1))
  135.      (setq rll (itoa (+ curRow deltaRow)))
  136. (setq cel (strcat cll rll))
  137. (setq curId (strcat (nth temp list1) (itoa (+ curRow deltaRow)))
  138.    curCell (vlax-variant-value (vlax-invoke-method *item* "Evaluate" curId))
  139.    curVal (nth (1- temp) (nth (- curRow 1) outList))
  140.       )
  141.       (vlax-put-property curCell "Formula" curVal)
  142.       (vlax-release-object curCell)
  143.       (setq temp (1+ temp))
  144.     )
  145.     (setq curRow (1+ curRow))
  146. )
  147. (setq deltaRow  (+ deltaRow (- curRow 0)))
  148. (TerminaExcel)
  149. (princ)
  150. )


  151. ;;;产生一个和excel的列对应的表格
  152. (defun conexcelcolumn (/ a b list1)
  153.   (setq a 65 list1 nil)
  154.   (repeat 26
  155.     (setq list1 (append list1 (list (chr a))) a (1+ a))
  156.   )
  157.   (setq a 65)
  158.   (repeat 26
  159.     (setq b 65)
  160.     (repeat 26
  161.       (setq list1 (append list1 (list (strcat (chr a) (chr b)))))
  162.       (setq b (1+ b))
  163.     )
  164.     (setq a (1+ a))
  165.   )
  166.   list1
  167. )


  168. (princ "\n By qjchen@gmail.com, The command is qjchenb2e")
  169. (princ)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

 楼主| 发表于 2017-10-16 11:17:16 | 显示全部楼层
  1. ;;;;;;主程序
  2. (defun c:cadtoexcel (/ ANG ASH DEFAULT DXF DXF10 DXF11 E FLAG FUZZ I LENCOLUMN LENROW LST LST3 LSTP1 LSTP2 LSTP3 LSTP4 MSXL-XL24HOURCLOCK N NUMROW OBJ OLDLST1 P1 P2 PLST RANGE RET SS TXTLST X XLAPP XLCONTINUOUS)
  3. ;;;;选择集转表
  4.   (defun ss2lst        (ss / i e lst)
  5.     (setq i -1)
  6.     (repeat (sslength ss)
  7.       (setq e        (ssname ss (setq i (1+ i)))
  8.             lst        (cons e lst)
  9.       )
  10.     )
  11.   )
  12. ;;;;;删除重复元素
  13.   (defun deldump (lst / ret)
  14.     (vl-remove-if
  15.       (function        (lambda        (x)
  16.                   (IF (NOT (MEMBER x RET))
  17.                     (SETQ RET (CONS x RET))
  18.                     nil
  19.                   )
  20.                 )
  21.       )
  22.       lst
  23.     )
  24.     ret
  25.   )
  26. ;;;;;取精度
  27.   (defun fixnum        (bl)
  28.     (setq bl (/ (fix (* bl (expt 10.0 3))) (expt 10.0 3)))
  29.   )
  30. ;;;;根据X、Y坐标(各为一个表)求点表
  31.   (defun getplst (lst1 lst2 /)
  32.     (if        flag
  33.       (setq oldlst1 lst1)
  34.     )
  35.     (repeat (1- (length lst2))
  36.       (if (and (cadr lst1) (cadr lst2))
  37.         (progn
  38.           (setq flag nil)
  39.           (setq        lst (append (list (list        (list (car lst1) (car lst2))
  40.                                         (list (car lst1) (cadr lst2))
  41.                                         (list (cadr lst1) (cadr lst2))
  42.                                         (list (cadr lst1) (car lst2))
  43.                                   )
  44.                             )
  45.                             lst
  46.                     )
  47.           )
  48.           (setq lst1 (cdr lst1))
  49.           (if (and (cadr lst1) (cadr lst2))
  50.             (getplst lst1 lst2)
  51.           )
  52. ;;;递归
  53.         )
  54.       )
  55.       (setq lst2 (cdr lst2))
  56.       (if (cadr lst2)
  57.         (setq lst1 oldlst1)
  58.         (setq oldlst1 nil)
  59.       )
  60.     )
  61.   )
  62. ;;;excel输出函数,来源MJTD(局部有修改)
  63. ;;;  加载EXCEL类型库
  64.   (defun DSX-TypeLib-Excel (/ path tlb)
  65.     (setq obj (vlax-create-object "Excel.Application"))
  66.     (setq path (vlax-get-property obj 'Path))
  67.     (cond
  68.       ((setq tlb (findfile (strcat path "\\Excel8.olb"))) tlb)
  69.       ((setq tlb (findfile (strcat path "\\Excel9.olb"))) tlb)
  70.       ((setq tlb (findfile (strcat path "\\Excel10.olb"))) tlb)
  71.       ((setq tlb (findfile (strcat path "\\Excel.exe"))) tlb)
  72.       (t
  73.        (alert
  74.          "本系统内未找到EXCEL97、2000、2002、2003、2010,初始化失败!"
  75.        )
  76.       )
  77.     )
  78.   )
  79. ;;;定义类型库接口
  80.   (defun DSX-Load-TypeLib-Excel        (/ tlbfile tlbver out)
  81.     (cond
  82.       ((null msxl-xl24HourClock)
  83.        (if (setq tlbfile (DSX-TypeLib-Excel))
  84. ;;;加载EXCEL类型库
  85.          (progn
  86.            (setq tlbver (substr (vl-filename-base tlbfile) 1 6))
  87.            (cond
  88.              ((= tlbver "10")
  89.               (princ "\n初始化 Microsoft Excel 2002...")
  90.              )
  91.              ((= tlbver "9")
  92.               (princ "\n初始化 Microsoft Excel 2000...")
  93.              )
  94.              ((= tlbver "8") (princ "\n初始化 Microsoft Excel 97..."))
  95.              ((= (vl-filename-base tlbfile) "Excel")
  96.               (princ "\n初始化 Microsoft Excel ...")
  97.              )
  98.            )
  99.            (vlax-import-type-library
  100.              :tlb-filename
  101.              tlbfile
  102.              :methods-prefix
  103.              "msxl-"
  104.              :properties-prefix
  105.              "msxl-"
  106.              :constants-prefix
  107.              "msxl-"
  108.            )
  109.            (if msxl-xl24HourClock
  110.              (setq out T)
  111.            )
  112.          )
  113.        )
  114.       )
  115.       (T (setq out T))
  116.     )
  117.     out
  118.   )
  119. ;;;打开带有新的工作簿的 Excel
  120.   (defun DSX-Open-Excel-New (dmode / appsession)
  121.     (princ "\n创建一个新的 Excel 电子表格文件...")
  122.     (cond ((setq appsession (vlax-create-object "Excel.Application"))
  123.            (vlax-invoke-method
  124.              (vlax-get-property appsession 'WorkBooks)
  125.              'Add
  126.            )
  127.            (if (= (strcase dmode) "SHOW")
  128.              (vla-put-visible appsession 1)
  129.              (vla-put-visible appsession 0)
  130.            )
  131.           )
  132.     )
  133.     appsession
  134.   )
  135. ;;; 获取行<relrow> 和列 <relcol>范围内的单个单元格对象
  136.   (defun DSX-Excel-Get-Cell (rng relrow relcol)
  137.     (vlax-variant-value
  138.       (msxl-get-item
  139.         (msxl-get-cells rng)
  140.         (vlax-make-variant relrow)
  141.         (vlax-make-variant relcol)
  142.       )
  143.     )
  144.   )
  145. ;;;将列表写到工作表指定行(startrow) 中的指定起始列(startcol)
  146.   (defun DSX-Excel-Put-RowList (lst startrow startcol)
  147.     (foreach itm lst
  148.       (msxl-put-value2
  149.         (DSX-Excel-Get-Cell range startrow startcol)
  150.         itm
  151.       )
  152.       (setq startcol (1+ startcol))
  153.     )
  154.   )
  155. ;;; 为指定单元格填入颜色
  156.   (defun DSX-Excel-Put-CellColor (row col intcol / rng)
  157.     (setq rng (DSX-Excel-Get-Cell (msxl-get-ActiveSheet xlapp) row col))
  158.     (msxl-put-colorindex (msxl-get-interior rng) intcol)
  159.   )

  160. ;;;为一行单元格填入颜色
  161.   (defun DSX-Excel-Put-RowCellsColor
  162.          (startrow startcol cols intcol / next)
  163.     (setq next startcol)
  164.     (repeat cols
  165.       (DSX-Excel-Put-CellColor startrow next intcol)
  166.       (setq next (1+ next))
  167.     )
  168.   )
  169. ;;;为选中的范围的实行自动调整宽度
  170.   (defun DSX-Excel-RangeAutoFit        (active-sheet)
  171.     (vlax-invoke-method
  172.       (vlax-get-property
  173.         (vlax-get-property
  174.           (vlax-get-property active-sheet 'UsedRange)
  175.           'Cells
  176.         )
  177.         'Columns
  178.       )
  179.       'AutoFit
  180.     )
  181.   )
  182. ;;;为选中的范围的实行网格线(自加)
  183.   (defun DSX-Excel-gridline (active-sheet)
  184.     (vlax-invoke-method
  185.       (vlax-get-property
  186.         (vlax-get-property
  187.           (vlax-get-property active-sheet 'UsedRange)
  188.           'Cells
  189.         )
  190.         'Columns
  191.       )
  192.       'BorderAround
  193.       xlContinuous
  194.       default
  195.       1
  196.     )
  197.   )
  198. ;;;退出并关闭Excel进程
  199.   (defun DSX-Excel-Quit        (appsession)
  200.     (cond ((not (vlax-object-released-p appsession))
  201.            (vlax-release-object appsession)
  202.           )
  203.     )
  204.   )
  205. ;;;输出到excel
  206.   (defun tjwb
  207.          (lst / plst ss n txt lst1 lst2 m lst3 lst_bzmp i lst4 lst5)
  208.     (setq m 0)
  209.     (foreach x lst
  210.       (setq ss (ssget "wp" x '((0 . "*TEXT"))))
  211.       (if (not ss)
  212.         (setq ss (ssget "Cp" x '((0 . "*TEXT"))))
  213.       )
  214.       (SETQ N        0
  215.             txt        ""
  216.       )
  217.       (if (and ss (< N (SSLENGTH SS)))
  218.         (progn
  219.           (WHILE (and ss (< N (SSLENGTH SS)))
  220.             (setq
  221.               txt (strcat (CDR (ASSOC 1 (ENTGET (SSNAME SS N)))) txt)
  222.             )
  223.             (SETQ LST1 (LIST txt))
  224.             (SETQ N (1+ N))
  225.           )
  226.         )
  227.         (progn
  228.           (setq txt "")
  229.           (SETQ LST1 (LIST txt))
  230.         )
  231.       )
  232.       (if (< m (1- lencolumn))
  233.         (progn
  234.           (SETQ lst2 (APPEND lst2 lst1))
  235.         )
  236.         (setq lst3 (APPEND lst3 (list lst2))
  237.               m           0
  238.               lst2 lst1
  239.               lst1 nil
  240.         )
  241.       )
  242.       (setq m (1+ m))
  243.     )
  244.     (setq lst3 (APPEND lst3 (list lst2)))
  245.     (DSX-Load-TypeLib-Excel)
  246.     (cond ((setq xlapp (DSX-Open-Excel-New "SHOW")
  247.                  ash   (msxl-Get-ActiveSheet xlapp)
  248.                  range (msxl-Get-ActiveCell xlapp)
  249.            )
  250.           )
  251.     )
  252.     (setq numrow 1
  253.           i 0
  254.     )
  255.     (mapcar (function
  256.               (lambda (x)
  257.                 (DSX-Excel-Put-RowList x numrow 1)
  258.                 (DSX-Excel-Put-rowCellsColor 1 1 (length (car lst3)) 7)
  259.                 (setq i             (1+ i)
  260.                       numrow (1+ numrow)
  261.                 )
  262.               )
  263.             )
  264.             lst3
  265.     )
  266.     (DSX-Excel-RangeAutoFit ash)
  267.     (DSX-Excel-gridline ash)
  268.     (DSX-Excel-Quit ash)
  269.   )
  270.   (VL-LOAD-COM)
  271.   (setq        p1 (getpoint "\n 请框选要导出EXCEL的表格")
  272.         p2 (getcorner p1 "\n 请框选要导出EXCEL的表格")
  273.   )
  274.   (setq        ss   (ssget "c" p1 p2 '((0 . "LINE")))
  275.         n    -1
  276.         fuzz 1e-3
  277.   )
  278.   (repeat (sslength ss)
  279.     (setq e        (ssname ss (setq n (1+ n)))
  280.           dxf        (entget e)
  281.           dxf10        (cdr (assoc 10 dxf))
  282.           dxf11        (cdr (assoc 11 dxf))
  283.           ang        (angle dxf10 dxf11)
  284.     )
  285.     (cond ((or (equal ang 0. fuzz) (equal ang pi fuzz))
  286.            (setq lstp1 (append lstp1 (list (list dxf10 dxf11))))
  287. ;;;(redraw e 3)
  288.           )
  289.           ((equal (rem ang pi) 3.14159 fuzz)
  290.            (setq lstp1 (append lstp1 (list (list dxf11 dxf10))))
  291. ;;;(redraw e 4)
  292.           )
  293.           ((or (equal ang (* pi 0.5) fuzz) (equal ang (* pi 1.5) fuzz))
  294.            (setq lstp2 (append lstp2 (list (list dxf10 dxf11))))
  295.           )
  296.           ((equal (rem ang pi) 1.5708 fuzz)
  297.            (setq lstp2 (append lstp2 (list (list dxf11 dxf10))))
  298.           )
  299.     )
  300.   )

  301.   (setq        lenrow          (length (setq        lstp3
  302.                                  (vl-sort
  303.                                    (deldump (mapcar '(lambda (x) (fixnum (cadar x))) lstp1)
  304.                                    )
  305.                                    '<
  306.                                  )
  307.                           )
  308.                   )

  309.         lencolumn (length (setq        lstp4
  310.                                  (vl-sort
  311.                                    (deldump
  312.                                      (mapcar '(lambda (x) (fixnum (caar x))) lstp2)
  313.                                    )
  314.                                    '>
  315.                                  )
  316.                           )
  317.                   )
  318.   )
  319.   (setq flag t)
  320.   (getplst lstp4 lstp3)
  321.   (setq        plst   lst
  322.         lst    nil
  323.         txtlst (tjwb plst)
  324.   )
  325.   (princ
  326.     "\nCAD线表格导出到EXCEL,仅支持直线。BY YJR111,命令cadtoexcel."
  327.   )
  328.   (princ)
  329. )




论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

 楼主| 发表于 2017-10-16 11:18:59 | 显示全部楼层
  1. (defun c:c2e (/ hangdau)
  2.   (defun sosanh        (e1 e2 / p1 p2)
  3.     (setq p1 (car e1)
  4.           p2 (car e2)
  5.     )
  6.     (if        (equal (cadr p1) (cadr p2) fuzz)
  7.       (< (car p1) (car p2))
  8.       (< (cadr p2) (cadr p1))
  9.     )
  10.   )
  11.   (setq
  12.     ss            (ssget '((0 . "TEXT")))
  13.     lst            (ss2ent ss)
  14.     lst            (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e)))))
  15.                     lst
  16.             )
  17.     lst            (mapcar '(lambda (e)
  18.                        (if (= (cdr e) "*")
  19.                          (cons (car e) "")
  20.                          e
  21.                        )
  22.                      )
  23.                     lst
  24.             )
  25.     caotext (cdr (assoc 40 (entget (ssname ss 0))))
  26.     fuzz    (* caotext 1.0)
  27.     lst            (vl-sort lst 'sosanh)
  28.     index   1
  29.     oldy    nil
  30.     fn            (getfiled "保存文件名" "" "csv" 1)
  31.     fid            (open fn "w")
  32.   )
  33.   (foreach e lst
  34.     (if        (equal oldy (cadr (car e)) fuzz)
  35.       (progn
  36.         (princ "," fid)
  37.         (setq index (1+ index))
  38.       )
  39.       (progn
  40.         (if hangdau
  41.           (progn
  42.             (setq index 1)
  43.             (princ "\n" fid)
  44.           )
  45.           (setq hangdau t)
  46.         )
  47.       )
  48.     )
  49.     (princ (cdr e) fid)
  50.     (setq oldy (cadr (car e)))
  51.   )
  52.   (close fid)
  53. )
  54. (defun ss2ent (ss / sodt index lstent)
  55.   (setq
  56.     sodt  (if ss
  57.             (sslength ss)
  58.             0
  59.           )
  60.     index 0
  61.   )
  62.   (repeat sodt
  63.     (setq ent         (ssname ss index)
  64.           index         (1+ index)
  65.           lstent (cons ent lstent)
  66.     )
  67.   )
  68.   (reverse lstent)
  69. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

 楼主| 发表于 2017-10-16 11:20:51 | 显示全部楼层
本帖最后由 /db_自贡黄明儒_ 于 2017-10-18 13:35 编辑

综上所述,truetabe真不错,但有版本限制,而且还要付费。所以自己的还得自己编写,这样可以适用于各个版本
ttt.png
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 196个

财富等级: 日进斗金

发表于 2017-10-16 13:10:41 | 显示全部楼层
都不是最新版的啊
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1306个

财富等级: 财源广进

发表于 2017-10-16 19:16:14 | 显示全部楼层

看起来功能还是比较齐全。

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 6050个

财富等级: 富甲天下

发表于 2017-10-17 00:05:32 | 显示全部楼层
确实是好东西。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 2764个

财富等级: 家财万贯

发表于 2017-10-23 09:29:58 | 显示全部楼层
回帖是一种美德!感谢楼主的无私分享 谢谢
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 24个

财富等级: 恭喜发财

发表于 2017-10-25 09:53:54 | 显示全部楼层
你们都是前辈。
也在研究数据提取。
能否不打开cad就你能提取,比如用python爬虫在一堆dwg文件抓数据。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 167个

财富等级: 日进斗金

发表于 2017-10-25 22:35:17 | 显示全部楼层

乐游游戏安装程序包????
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1个

财富等级: 恭喜发财

发表于 2017-11-10 11:18:57 | 显示全部楼层
楼主:除了TRUETABLE哪个也是可以CAD-EXCEL互转的?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

本版积分规则

QQ|申请友链|小黑屋|手机版|Archiver|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )  

GMT+8, 2021-2-27 11:53 , Processed in 0.223480 second(s), 53 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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