nonsmall 发表于 2011-7-18 14:50

[不死猫出品] VBA-LISP 代码转换工具（源码）

本帖最后由 nonsmall 于 2013-5-28 22:32 编辑

大家好！
好久没发东西了，今天翻箱底发现这个，拿上来与大伙分享
原文思路在这里：
http://bbs.mjtd.com/thread-72391-1-1.html
完整源码收1个明经币

下面是部分源代码……

(defun vba(vba_str / p1 p2 vba_express vba_item vba_items vba_lst vba_num vba_object vba_ref vba_tmp)
(setq vba_lst (non_string_to_list vba_str "."))
(foreach vba_item vba_lst
(cond
   ((= (strcase vba_item) "APP");根对象
    (setq vba_object (vlax-get-acad-object))
   )
   ((= (strcase vba_item) "THISDRAWING");当前图档
    (setq vba_object (vla-get-activedocument(vlax-get-acad-object)))
   )
   ((= vba_item (car vba_lst));获取对象
    (setq vba_object (eval (read vba_item)))
   )
   ((vl-string-search "ITEM" (strcase vba_item));集合中的vba_item处理
    (setq vba_tmp (non_string_to_list vba_item "("))
    (setq vba_item (car vba_tmp))
    (setq vba_item (vl-string-right-trim " " vba_item))
    (setq vba_num (read (vl-string-right-trim ")" (cadr vba_tmp))))
    (cond
   ((= (type vba_num) 'INT)
      (setq vba_num (vl-string-right-trim ")" (cadr vba_tmp)))
   )
   ((= (type vba_num) 'SYM)
      (setq vba_num (vl-string-right-trim ")" (cadr vba_tmp)))
   )
   ((= (type vba_num) 'STR)
      (setq vba_num (vl-string-right-trim ")" (cadr vba_tmp)))
   )
    )
    (setq vba_express (strcat "(setq vba_object (vla-itemvba_object " vba_num "))"))
    (if (vl-catch-all-error-p(vl-catch-all-apply 'eval (list (read vba_express))))
   (eval (read (strcat "(setq vba_object (vlax-get-propertyvba_object 'item " vba_num "))")))
    )
   )
((and (vl-string-position (ascii "(") vba_item);索引处理
    (setq p1 (vl-string-position (ascii "(") vba_item))
    (setq p2 (vl-string-position (ascii ")") vba_item))
    (numberp (eval (read (setq vba_num (substr vba_item (+ p1 2) (- p2 p1 1))))))
    )
    (setq vba_tmp (non_string_to_list vba_item "("))
    (setq vba_ref (car vba_tmp))
    (setq vba_ref (vl-string-right-trim " " vba_ref))   
    (if (vl-string-position (ascii "=") vba_item)
   (progn
      (setq vba_tmp (non_string_to_list vba_item "="))
      (eval (read (strcat "(setq vba_object (vlax-put-property vba_object '" vba_ref " " vba_num " " (cadr vba_tmp) "))")))
   )
   (eval (read (strcat "(setq vba_object (vlax-get-property vba_object '" vba_ref " " vba_num "))")))
    )
   )
)
)
(cond
((= vba_object :vlax-true)
   T
)
((= vba_object :vlax-false)
   nil
)
(T
   vba_object
)
)
)



gbhsu 发表于 2011-7-18 14:54

非常厉害的版主，学习了！
呵呵！

lee50310 发表于 2022-3-21 09:37

本帖最后由 lee50310 于 2022-3-21 09:39 编辑

奇怪了!   
下載後,載入程式 照樓主提供的方式執行 出現錯誤
(setq newlay (vba "layers.add(\"234\")"))
錯誤: 損壞的引數類型: VLA-OBJECT nil

(vba "lay.color=3")
; 錯誤: 損壞的引數類型: VLA-OBJECT nil






里皎相 发表于 2022-9-30 00:17

很好很强大，最近在开发某些自己需要的功能，这个刚好可以学习各种转换的代码。

qcw911 发表于 2011-7-18 14:52

猫猫发帖子啦~~~

nonsmall 发表于 2011-7-18 14:58

额 好快的抢楼手法……

程序的返回值还是vlisp格式的 先转换而后执行 其他的代码？大家DIY好了

命令: (setq layers (vba "activedocument.layers"))
#<VLA-OBJECT IAcadLayers2 0266a7a4>
命令: (setq newlay (vba "layers.add(\"234\")"))
#<VLA-OBJECT IAcadLayer2 026b3844>
命令: (vba "newlay.color=6")
nil

命令: (setq lay(vba "activedocument.layers.add(\"111\")"))
#<VLA-OBJECT IAcadLayer2 026b4954>
命令: (vba "lay.color=3")
nil
命令: (vba "activedocument.layers.item(\"111\").color=1")
nil

zhynt 发表于 2011-7-18 15:05

挖个坑蹲着。

tm20038175 发表于 2011-7-18 16:51

使用这个操控excel岂不是很方便了？

仲文玉 发表于 2011-7-18 17:48

支持猫猫工具，

xq4u 发表于 2011-7-18 17:54

没想到真的把这想法变成了现实，楼主真是神人也

祥子 发表于 2011-7-18 18:09

老猫要常来逛逛啊,你的帖子都很具代表性啊

xchrimp 发表于 2011-7-18 18:17

本帖最后由 xchrimp 于 2011-7-18 18:20 编辑

没有实用性，网友定制程序不会用到这些。学习LISP也不会学这没价值的附加资料
页: [1] 2 3 4 5 6 7 8 9 10
查看完整版本: [不死猫出品] VBA-LISP 代码转换工具（源码）