求助!cad数据输出excel

yaokui25

难道标题不够醒目，还是问题有些棘手，希望给位老大能看看
放假这几天天都在线等，等的好辛苦

yaokui25

版主大人，帮忙看看吧

yaokui25

不能沉
一直等

陨落

这种大型的程序我想应该不会有谁会免费花时间帮你写吧

sicky111

有个turetable的插件，专门处理CAD与EXCEL表格数据转换的，楼主可以试试。

yaokui25

sicky111 发表于 2013-5-5 15:29
有个turetable的插件，专门处理CAD与EXCEL表格数据转换的，楼主可以试试。

谢谢您的支持

yaokui25

陨落 发表于 2013-5-5 13:04
这种大型的程序我想应该不会有谁会免费花时间帮你写吧

嗯~有可能吧，谢谢您的支持

yaokui25

老大，在吗？帮帮小弟

yxp

求人不如求己啊，自己看看代码，真的不难，看着你比较诚心的份上，发一下代码，提前说明一下，其中大部分代码都是来自本论坛的。

;; 第一步: Excel 家住在哪里呢？打个114电话查询一下
;; 函数: ddd-TypeLib-Excel
;; 功能: 寻找 Excel 的安装路径
;; 返回: 返回 excel.exe 的全路径
(defun ddd-TypeLib-Excel ( / sysdrv tlb GGG)
(setq sysdrv (getenv "systemdrive"))
;;先从注册表中搜索安装位置，把这一句放在前面的好处是，如果遇到了excel新发布的版本，也可以顺利找到路径。
(and (setq GGG (vl-registry-read
        "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\Excel.EXE"        "Path"))
(setq tlb (findfile (strcase (strcat GGG "Excel.EXE")))))

(if (null tlb)
(cond  ;;从windows系统盘搜索excel的安装位置
   ((setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office11\\Excel.exe"))) tlb)  ;;2003
   ((setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office12\\Excel.exe"))) tlb)  ;;2007
   ((setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office14\\Excel.exe"))) tlb)  ;;2010
))
(if tlb tlb (princ "\n 未找到 Excel 2003\\2007\\2010 的安装路径"))
)



;; 第二步: 砰 砰 砰，Excel，有事找你，请开个门吧。Excel: 门没锁你自己进来吧。
;; 函数: ddd-Load-Excelapp
;; 功能: 定义 Excel 的类型库接口
(defun ddd-Load-Excelapp ( / tlbfile tlbver out)
(cond
  ((null msxl-xl24HourClock)
    (if (setq tlbfile (ddd-TypeLib-Excel))
       (progn  (setq tlbver (substr (vl-filename-base tlbfile) 6))
          (vlax-import-type-library :tlb-filename tlbfile
                                    :methods-prefix "msxl-"
                                    :properties-prefix "msxl-"
                                    :constants-prefix "msxl-"
           )
      (if msxl-xl24HourClock (setq out T))
      )
    )
  )
  (T (setq out T) )
) out
)



;; 第三步: 进入excel家里，我这里有一份数据能放在你家吗？Excel: 可以，我把保险柜钥匙(*ddd-xlapp*)给你
;; 函数: Open-Excel-New
;; 功能: 打开带有新的工作簿的 Excel
;; 参数: <dmode> 可以设为 "SHOW" (显示)或 "HIDE" (隐藏)，它取决于你希望
;;       Excel 进程是否可以让用户直接操作访问。
;; 返回: *ddd-xlapp* 全局变量
;; 样例: (Open-Excel-New "SHOW")
(defun Open-Excel-New (dmode / appsession)
(ddd-Load-Excelapp)
(princ "\n 创建一个新的 Excel 电子表格文件...")
   (cond
     ((setq appsession (vlax-create-object "Excel.Application"))
        (vlax-invoke-method (vlax-get-property appsession 'WorkBooks) 'Add)
        (if (= (strcase dmode) "SHOW")
           (vla-put-visible appsession 1)
           (vla-put-visible appsession 0)
         )
     )
)(setq *ddd-xlapp* appsession)
)



;; 第四步: 拿到钥匙(*ddd-xlapp*)，有数据随时可以保存了。
;; 函数: vlxls-cell-put-value
;; 功能: 指定单元格开始赋值
;; 参数: <xl> as object 钥匙 <id> as string 在excel单元格的位置 <data> as lists 需要保存的数据
;; 需要自定义函数: ddd-vlxls-cellidcalc / ddd-vlxls-cellid / ddd-vlxls-rangeid 的支持
;; 样例:
;; (vlxls-cell-put-value *ddd-xlapp* "C12:F3" "xx")  
;; (vlxls-cell-put-value *ddd-xlapp* "A1" '(("zz" "xx") ("xx" "zz")))
(defun vlxls-cell-put-value (xl id Data / idx xx yy ary Rtn)
   (defun vllist-explode (lst)
      (cond
         ((not lst) nil)
         ((atom lst) (list lst))
         ((append (vllist-explode (car lst))
                        (vllist-explode (cdr lst))
               )
         )
      )
   )
   (if (null id) (setq id "A1" ))
   (if (= (type id) 'list) (setq id (ddd-vlxls-rangeid id)))
   (if (= (type (car Data)) 'LIST)
      (setq   ARY    (vlax-make-safearray
                     vlax-vbstring
                     (cons 0 (1- (length Data)))
                     (cons 1 (length (car Data)))
                  )
            XX (1- (length (car Data)))
            YY (1- (length Data))
      )
      (setq   ARY    (vlax-make-safearray
                     vlax-vbstring
                     (cons 0 1)
                     (cons 1 (length Data))
                  )
            XX (1- (length Data))
            YY 0
      )
   )
   (if (= xx yy 0)
      (msxl-put-value2
         (setq Rtn (msxl-get-range xl id))
         (car (vllist-explode data))
      )
      (progn
         (setq id (ddd-vlxls-cellidcalc id xx yy))
         (msxl-put-value2
            (setq Rtn (msxl-get-range xl id))
            (vlax-safearray-fill ary data)
         )
      )
   )
   Rtn
)





;; Excel 数据保存支持函数
;; 功能: 计算数据填的充范围
(Defun ddd-vlxls-cellidcalc (id x y / idx)
  (setq id (car (ddd-vlxls-cellid id))
          idx (ddd-vlxls-rangeid id)
            x (+ x (car idx))
            x (if (< x 1) 1 x)
            y (+ y (cadr idx))
            y (if (< y 1)        1 y)
          idx (ddd-vlxls-rangeid (list x y))
           id (ddd-vlxls-cellid (strcat id ":" idx))
           id (strcat (car id) ":" (cadr id)))
  id
)

;; Excel 数据保存支持函数
;; 功能: Range格式转为表
;; 样例:
;; (ddd-vlxls-cellid '(3 14)) return: ("C14" "")
(Defun ddd-vlxls-cellid (id / xx id1 id2 Rtn) ;;;;cell id 转换
  (if (= (type id) 'list) (setq id (ddd-vlxls-rangeid id)))
  (setq id (strcase id))
  (if (null (setq xx (vl-string-search ":" id)))
      (setq Rtn (list id ""))
      (setq id1 (substr id 1 xx)
                 id2 (substr id (+ xx 2))
                 id1 (ddd-vlxls-rangeid id1)
                 id2 (ddd-vlxls-rangeid id2)
                 Rtn (list (ddd-vlxls-rangeid (list (min (car id1) (car id2))
                      (min (cadr id1) (cadr id2))))
                           (ddd-vlxls-rangeid (list (max (car id1) (car id2))
                                            (max (cadr id1) (cadr id2)))))
            )
) Rtn
)

yaokui25

yxp 发表于 2013-5-6 06:50
求人不如求己啊，自己看看代码，真的不难，看着你比较诚心的份上，发一下代码，提前说明一下，其中大部分代 ...

终于看希望了，谢谢您
我只能看懂一些简单的代码
像这样的有难度的代码对我来讲简直就像天书，我本身不是学英语的多数都看不懂
如果您时间方便的话，能不能按上面的要求给小弟编一段程序