明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
楼主: smartstar

[源码] 由EXCEL定义数据批量建层(源码,2015年11月3日更新)

    [复制链接]
发表于 2012-9-3 23:23:14 | 显示全部楼层
有想法!
发表于 2012-9-4 19:49:27 | 显示全部楼层
写得不错,赞一个~
发表于 2012-9-6 09:15:52 | 显示全部楼层
错误: no function definition: MSXL-GET-ACTIVESHEET
LSP和FAS的我都测试了,我使用的是office 2010,

点评

2015年11月3日 取消调用函数“msxl-get-ActiveSheet”,解决部分用户无法使用的问题 增加高版本excel的支持,支持.xls和.xlsx格式  发表于 2015-11-3 11:11
http://www.atablex.com/htmls/vlxls-functions.htm  发表于 2012-9-6 13:13
你可以看看这里http://bbs.mjtd.com/forum.php?mod=viewthread&tid=95254&page=1  发表于 2012-9-6 13:11
发表于 2012-9-6 21:28:31 | 显示全部楼层
程序是不错,但是有必要在excel里面搞这个图层设置吗?感觉有点远
发表于 2012-9-7 09:32:14 | 显示全部楼层
半听可乐 发表于 2012-9-3 21:21
我确实是把office卸载了,比较喜欢用wps,程序应该怎么改成调用wps版的呢?

建议你看一下AutoCAD完全应用指南autolisp dcl vilsual lisp程序设计篇中的Visuallisp活用于EXCEL,
发表于 2012-9-7 09:42:46 | 显示全部楼层
本帖最后由 革天明 于 2012-9-7 09:44 编辑
半听可乐 发表于 2012-9-3 21:21
我确实是把office卸载了,比较喜欢用wps,程序应该怎么改成调用wps版的呢?

下面程序用于将多段线各点坐标输出至EXCEL,可以参考一下,把WPS的路径也加进去试一试,以前喜欢WPS,现在觉得不主主流就不用了,对07的格式不兼容,现在使用破解的office 2010
;;; 将多段线相关点坐标写入EXCEL文件内
(defun c:xl-test4 ()
   (get_pline_data_list)
   (if (null MX-ACOS)
     (jinn-get-excel-Lib)
   )
   (jinn-creat-excel-sheet)
   (sub-xl-test4 pline_data_list)
   (prin1)
)
;;将所有点坐标列表写入EXCEL各单元格中
(defun sub-xl-test4 (data_list)
   (setq        i 1
         j 1
   )
   (foreach val '("Index" "X" "Y")
     (setq ceobj (get-XL-cell sheetobj i j))
     (put-cell-bkcolor ceobj 3 5 2 12 val)
     (setq j (1+ j))
   )
   (setq        i 2
         j 1
         index 1
   )
   (foreach lista data_list
     (setq ceobj (get-XL-cell sheetobj i j))
     (mx-put-HorizontalAlignment ceobj 3)
     ;;向中对齐
     (mx-put-value2 ceobj index)
     (setq j (1+ j))
     (foreach data lista
       (setq ceobj (get-XL-cell sheetobj i j))
       (mx-put-HorizontalAlignment ceobj 4)
       ;;向右对齐
       (mx-put-value2 ceobj data)
       (setq j (1+ j))
     )
     (setq i        (1+ i)
           j        1
           index        (1+ index)
     )
   )
)
;;;创建EXCEL应用程序对象与窗体对象
(defun jinn-creat-excel-sheet ()
   (setq XLobj (vlax-create-object "Excel.Application"))
   (vla-put-visible XLobj 1)
   ;; (vla-put-visible XLobj :vlax-true)
   (setq        wb-obj (vlax-invoke-method
                  (vlax-get-property XLobj 'WorkBooks)
                  'Add
                )
   )
   (setq sheetobj (MX-get-activesheet wb-obj))
   (setq cells (MX-get-cells sheetobj))
)
;;;取得所有多段线的点坐标数据列表
(defun get_pline_data_list ()
   (setq        pline_data_list        nil
         lista nil
   )
   (setq ent (car (entsel "\n请选择多段线:")))
   ;; 选择楼梯
   (setq plineobj (vlax-ename->vla-object ent))
   (vla-get-coordinates plineobj)
   (setq sa_val (vlax-variant-value (vla-get-coordinates plineobj)))
   (setq x_y_all_list (vlax-safearray->list sa_val))
   (setq        i 1
         xylist nil
   )
   (foreach val x_y_all_list
     (setq xylist (cons (rtos val 2 2) xylist))
     (if        (= (rem i 2) 0)
       (progn
         (setq xylist (reverse xylist))
         (setq lista (cons xylist lista))
         (setq xylist nil)
       )
     )
     (setq i (1+ i))
   )
   (setq pline_data_list (reverse lista))
)
;;;加载EXCEL应用程序资源库文件
(defun jinn-get-excel-Lib ()
   (setq sys:drv (getenv "systemdrive"))
   (setq office:dir "C:\\Program Files\\Microsoft Office\\")
   (cond
     ((setq exlib (findfile (strcat office:dir "office\\" "Excel8.olb")))
     )
     ((setq exlib (findfile (strcat office:dir "office\\" "Excel9.olb")))
     )
     ((setq exlib (findfile (strcat office:dir "office\\" "Excel.exe")))
     )
     ((setq
        exlib (findfile (strcat office:dir "office11\\" "Excel.exe"))
      )
     )
     ((setq
        exlib (findfile (strcat office:dir "office12\\" "Excel.exe"))
      )
     )
     (t (setq exlib nil))
   )
   (if exlib
     (vlax-import-type-library
       :tlb-filename        exlib                  :methods-prefix
       "MX-"                :properties-prefix
       "MX-"                :constants-prefix "MX-"
      )
     (alert "Excel typelib 文件不存在")
   )
)
;;;取得指定的单元格对象
(defun GET-XL-CELL (wkst row col)
   (vlax-Variant-Value
     (MX-Get-Item (MX-Get-Cells wkst) row col)
   )
)
;;        (put-cell-bkcolor 单元格对象 对齐方式 背景颜色 文字颜色 字号 数据内容)
(defun put-cell-bkcolor        (obj atype bkcc txtcc txthh data)
   (mx-put-horizontalalignment obj atype)
   (mx-put-bold (mx-get-font obj) 1)
   (mx-put-colorindex (mx-get-interior obj) bkcc)
   (mx-put-colorindex (mx-get-font obj) txtcc)
   (mx-put-size (mx-get-font obj) txthh)
   (mx-put-value2 obj data)
)
;;(put-cell-txtcolor 单元格对象 对齐方式 文字颜色 字号 数据内容)
(defun put-cell-txtcolor (obj atype txtcc txthh data)
   (mx-put-horizontalalignment obj atype)
   (mx-put-bold (mx-get-font obj) 1)
   (mx-put-colorindex (mx-get-font obj) txtcc)
   (mx-put-size (mx-get-font obj) txthh)
   (mx-put-value2 obj data)
)
发表于 2012-9-9 23:24:53 | 显示全部楼层
发表于 2012-9-12 11:47:53 | 显示全部楼层
Initializing Microsoft Excel 2007...; 错误: 参数类型错误: VLA-OBJECT nil
这是怎么回事呀.是我的EXCEL 2007有问题还是不支持?

点评

2015年11月3日 取消调用函数“msxl-get-ActiveSheet”,解决部分用户无法使用的问题 增加高版本excel的支持,支持.xls和.xlsx格式  发表于 2015-11-3 11:12
XP,EXCEL2003,CAD2008&2012测试ok,excel2007没装,由于水平有限,有待慢慢琢磨研究是哪里的问题。你可请高手帮忙修改一下!  发表于 2012-9-12 13:03
发表于 2012-9-18 23:00:02 | 显示全部楼层
很好
发表于 2012-11-3 00:36:16 | 显示全部楼层
不错,谢谢楼主分享!!!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-12-22 23:31 , Processed in 0.171738 second(s), 20 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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