由EXCEL定义数据批量建层（源码，2015年11月3日更新）

pimgu

有想法！

dwg001

写得不错，赞一个~

革天明

错误: no function definition: MSXL-GET-ACTIVESHEET
LSP和FAS的我都测试了，我使用的是office 2010，

tianyi1230

程序是不错，但是有必要在excel里面搞这个图层设置吗？感觉有点远

革天明

半听可乐 发表于 2012-9-3 21:21
我确实是把office卸载了，比较喜欢用wps，程序应该怎么改成调用wps版的呢？

建议你看一下AutoCAD完全应用指南autolisp dcl vilsual lisp程序设计篇中的Visuallisp活用于EXCEL，

革天明

半听可乐 发表于 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)
)

pimgu

chenming10

Initializing Microsoft Excel 2007...; 错误: 参数类型错误: VLA-OBJECT nil
这是怎么回事呀.是我的EXCEL 2007有问题还是不支持?

c735023723

很好

mj520plus

不错，谢谢楼主分享！！！