有想法！
写得不错，赞一个~
错误: no function definition: MSXL-GET-ACTIVESHEET
LSP和FAS的我都测试了，我使用的是office 2010，
程序是不错，但是有必要在excel里面搞这个图层设置吗？感觉有点远
半听可乐 发表于 2012-9-3 21:21 static/image/common/back.gif
我确实是把office卸载了，比较喜欢用wps，程序应该怎么改成调用wps版的呢？
建议你看一下AutoCAD完全应用指南autolisp dcl vilsual lisp程序设计篇中的Visuallisp活用于EXCEL，
本帖最后由 革天明 于 2012-9-7 09:44 编辑
半听可乐 发表于 2012-9-3 21:21 static/image/common/back.gif
我确实是把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)
)
Initializing Microsoft Excel 2007...; 错误: 参数类型错误: VLA-OBJECT nil
这是怎么回事呀.是我的EXCEL 2007有问题还是不支持?
很好
不错，谢谢楼主分享！！！