【飞鸟集】心随我动--为LISP定制的动态输入,拖拉和动态信息函数(更新至20130731)

cnks

没有2004，不过看上去应该是可以的，要是有的话一定要测试一下

xiaotao

了不起！

Gu_xl

飞版辛苦了！2004测试成功！若再能支持2000~2002就完美了！写了个自动加载程序，程序根据cad版本自动加载飞版的arx不同版本文件！

1. ;;;将dynarxfor2004-2006.arx等四个文件拷贝到CAD支持目录！(autoladdynarx)函数根据CAD不同版本自动加载！
   
2. (defun autoladdynarx (/ loaded fn)
   
3.   (cond ((= 16 (atoi (getvar 'acadver)))
   
4.   (if (not (member "dynarxfor2004-2006.arx" (arx)))
   
5.     (if (setq fn (findfile "dynarxfor2004-2006.arx"))
   
6.       (setq loaded (arxload fn "1"))
   
7.       (setq loaded "2")
   
8.       )
   
9.     )
   
10.   )
    
11. ((= 17 (atoi (getvar 'acadver)))
    
12.   (if (not (member "dynarxfor2007-2009.arx" (arx)))
    
13.     (if (setq fn (findfile "dynarxfor2007-2009.arx"))
    
14.       (setq loaded (arxload fn "1"))
    
15.       (setq loaded "2")
    
16.       )
    
17.     )
    
18.   )
    
19. ((= 18 (atoi (getvar 'acadver)))
    
20.   (if (= "x86" (getenv "PROCESSOR_ARCHITECTURE"))
    
21.     (if (not (member "dynarxfor2010-2012x32.arx" (arx)))
    
22.       (if (setq fn (findfile "dynarxfor2010-2012x32.arx"))
    
23.         (setq loaded (arxload fn "1"))
    
24.         (setq loaded "2")
    
25.         )
    
26.       )
    
27.     (if (not (member "dynarxfor2010-2012x64.arx" (arx)))
    
28.       (if (setq fn (findfile "dynarxfor2010-2012x64.arx"))
    
29.         (setq loaded
    
30.         (arxload (findfile "dynarxfor2010-2012x64.arx")
    
31.           "1"))
    
32.         (setq loaded "2")
    
33.         )
    
34.       )
    
35.     )
    
36.   )
    
37. )
    
38.   (if (= "1" loaded)
    
39.     (progn
    
40.     (alert "dynarx加载失败！程序将退出！")
    
41.     (exit)
    
42.     )
    
43.     (if (= "2" loaded)
    
44.     (progn
    
45.     (alert "未找到对应的dynarx文件！程序将退出！")
    
46.     (exit)
    
47.     )
    
48.       (princ "dynarx成功加载！")
    
49.       )
    
50.     )
    
51.   (princ)
    
52.   )
    

;;;将dynarxfor2004-2006.arx等四个文件拷贝到CAD支持目录！(autoladdynarx)函数根据CAD不同版本自动加载！<br /> (defun autoladdynarx (/ loaded fn)<br />   (cond ((= 16 (atoi (getvar 'acadver)))<br />   (if (not (member "dynarxfor2004-2006.arx" (arx)))<br />     (if (setq fn (findfile "dynarxfor2004-2006.arx"))<br />       (setq loaded (arxload fn "1"))<br />       (setq loaded "2")<br />       )<br />     )<br />   )<br /> ((= 17 (atoi (getvar 'acadver)))<br />   (if (not (member "dynarxfor2007-2009.arx" (arx)))<br />     (if (setq fn (findfile "dynarxfor2007-2009.arx"))<br />       (setq loaded (arxload fn "1"))<br />       (setq loaded "2")<br />       )<br />     )<br />   )<br /> ((= 18 (atoi (getvar 'acadver)))<br />   (if (= "x86" (getenv "PROCESSOR_ARCHITECTURE"))<br />     (if (not (member "dynarxfor2010-2012x32.arx" (arx)))<br />       (if (setq fn (findfile "dynarxfor2010-2012x32.arx"))<br />         (setq loaded (arxload fn "1"))<br />         (setq loaded "2")<br />         )<br />       )<br />     (if (not (member "dynarxfor2010-2012x64.arx" (arx)))<br />       (if (setq fn (findfile "dynarxfor2010-2012x64.arx"))<br />         (setq loaded<br />         (arxload (findfile "dynarxfor2010-2012x64.arx")<br />           "1"))<br />         (setq loaded "2")<br />         )<br />       )<br />     )<br />   )<br /> )<br />   (if (= "1" loaded)<br />     (progn<br />     (alert "dynarx加载失败！程序将退出！")<br />     (exit)<br />     )<br />     (if (= "2" loaded)<br />     (progn<br />     (alert "未找到对应的dynarx文件！程序将退出！")<br />     (exit)<br />     )<br />       (princ "dynarx成功加载！")<br />       )<br />     )<br />   (princ)<br />   )<br />

Gu_xl

Gu_xl 发表于 2011-11-18 08:43
飞版辛苦了！2004测试成功！若再能支持2000~2002就完美了！写了个自动加载程序，程序根据cad版本自动加载飞 ...

我还发现一个问题，就是在打开cad第一次自动加载arx后接着调用(HFB_PointMonitor "InfoCallback")，不起作用，需要调调用一次(HFB_PointMonitor "InfoCallback")才起作用！以后再打开cad窗口就没问题了！原因何在？飞版帮助分析一下！再次感谢！
调用代码：

1. ;;;cad第一次加载，命令行运行tt，(HFB_PointMonitor "InfoCallback")没起作用，需再次运行tt才行！
   
2. (defun InfoCallback (dynpt / txt lst dat)
   
3.     (setq txt (vl-princ-to-string (mapcar 'rtos dynpt)))
   
4.     (setq txt (strcat "\n当前点的坐标是：" txt))
   
5.     (if (setq lst (nentselp dynpt))
   
6.       (progn
   
7. (setq dat (entget (car lst)))
   
8.         (strcat txt "\n这个图元的类型是：" (cdr (assoc 0 dat)))
   
9.       )
   
10.       txt
    
11.     )
    
12.   )
    
13. (defun c:tt  (/ loaded)
    
14.   (GXL-ERROR-INIT (list 'cmdecho 0))
    
15.   (cond ((= 16 (atoi (getvar 'acadver)))
    
16.   (if (not (member "dynarxfor2004-2006.arx" (arx)))
    
17.     (if (setq fn (findfile "dynarxfor2004-2006.arx"))
    
18.       (setq loaded (arxload fn "1"))
    
19.       (setq loaded "2")
    
20.       )
    
21.     )
    
22.   )
    
23. ((= 17 (atoi (getvar 'acadver)))
    
24.   (if (not (member "dynarxfor2007-2009.arx" (arx)))
    
25.     (if (setq fn (findfile "dynarxfor2007-2009.arx"))
    
26.       (setq loaded (arxload fn "1"))
    
27.       (setq loaded "2")
    
28.       )
    
29.     )
    
30.   )
    
31. ((= 18 (atoi (getvar 'acadver)))
    
32.   (if (= "x86" (getenv "PROCESSOR_ARCHITECTURE"))
    
33.     (if (not (member "dynarxfor2010-2012x32.arx" (arx)))
    
34.       (if (setq fn (findfile "dynarxfor2010-2012x32.arx"))
    
35.         (setq loaded (arxload fn "1"))
    
36.         (setq loaded "2")
    
37.         )
    
38.       )
    
39.     (if (not (member "dynarxfor2010-2012x64.arx" (arx)))
    
40.       (if (setq fn (findfile "dynarxfor2010-2012x64.arx"))
    
41.         (setq loaded
    
42.         (arxload (findfile "dynarxfor2010-2012x64.arx")
    
43.           "1"))
    
44.         (setq loaded "2")
    
45.         )
    
46.       )
    
47.     )
    
48.   )
    
49. )
    
50. 
    
51.   (if (not (or (= 1 loaded) (= 2 loaded)))
    
52.     (if *dynView* ;_ 储存图形浏览关闭或打开变量
    
53.       (progn
    
54. (HFB_PointMonitor)
    
55. (princ "\n图形浏览关闭！")
    
56. (setq *dynView* nil)
    
57. )
    
58.       (progn
    
59. (HFB_PointMonitor "InfoCallback")
    
60. (princ "\n图形浏览打开！")
    
61. (setq *dynView* t)
    
62. )
    
63.       )
    
64.     )
    
65.   
    
66.   (princ)
    
67.   )
    

;;;cad第一次加载，命令行运行tt，(HFB_PointMonitor "InfoCallback")没起作用，需再次运行tt才行！<br /> (defun InfoCallback (dynpt / txt lst dat)<br />     (setq txt (vl-princ-to-string (mapcar 'rtos dynpt)))<br />     (setq txt (strcat "\n当前点的坐标是：" txt))<br />     (if (setq lst (nentselp dynpt))<br />       (progn<br /> (setq dat (entget (car lst)))<br />         (strcat txt "\n这个图元的类型是：" (cdr (assoc 0 dat)))<br />       )<br />       txt<br />     )<br />   )<br /> (defun c:tt  (/ loaded)<br />   (GXL-ERROR-INIT (list 'cmdecho 0))<br />   (cond ((= 16 (atoi (getvar 'acadver)))<br />   (if (not (member "dynarxfor2004-2006.arx" (arx)))<br />     (if (setq fn (findfile "dynarxfor2004-2006.arx"))<br />       (setq loaded (arxload fn "1"))<br />       (setq loaded "2")<br />       )<br />     )<br />   )<br /> ((= 17 (atoi (getvar 'acadver)))<br />   (if (not (member "dynarxfor2007-2009.arx" (arx)))<br />     (if (setq fn (findfile "dynarxfor2007-2009.arx"))<br />       (setq loaded (arxload fn "1"))<br />       (setq loaded "2")<br />       )<br />     )<br />   )<br /> ((= 18 (atoi (getvar 'acadver)))<br />   (if (= "x86" (getenv "PROCESSOR_ARCHITECTURE"))<br />     (if (not (member "dynarxfor2010-2012x32.arx" (arx)))<br />       (if (setq fn (findfile "dynarxfor2010-2012x32.arx"))<br />         (setq loaded (arxload fn "1"))<br />         (setq loaded "2")<br />         )<br />       )<br />     (if (not (member "dynarxfor2010-2012x64.arx" (arx)))<br />       (if (setq fn (findfile "dynarxfor2010-2012x64.arx"))<br />         (setq loaded<br />         (arxload (findfile "dynarxfor2010-2012x64.arx")<br />           "1"))<br />         (setq loaded "2")<br />         )<br />       )<br />     )<br />   )<br /> )<br /> <br />   (if (not (or (= 1 loaded) (= 2 loaded)))<br />     (if *dynView* ;_ 储存图形浏览关闭或打开变量<br />       (progn<br /> (HFB_PointMonitor)<br /> (princ "\n图形浏览关闭！")<br /> (setq *dynView* nil)<br /> )<br />       (progn<br /> (HFB_PointMonitor "InfoCallback")<br /> (princ "\n图形浏览打开！")<br /> (setq *dynView* t)<br /> )<br />       )<br />     )<br />   <br />   (princ)<br />   )<br />

kwok

怎么没有2008的？我用的是2008bit64的.....

hhh454

期待50楼，分享源码，学习

Gu_xl

Gu_xl 发表于 2011-11-18 09:44
我还发现一个问题，就是在打开cad第一次自动加载arx后接着调用(HFB_PointMonitor "InfoCallback")，不起 ...

添加一句(vl-acad-defun 'InfoCallback)就搞定了！谢谢飞诗指点！

13579

可以用了。。。

flowerson

太厉害了！要顶。尽快到50楼。

3527188

顶到50也没用看不懂ARX