【求教】在一个CAD里调试好的程序换到另一个CAD里面就不能完美执行！

changxingge

问题如题，程序是在CAD2009为基础的天正道路软件上调试成功的，百试百灵，但是当我把程序加载到CAD2009和CAD2006时确不能完美运行了，不知是什么原因，特此请高手帮忙解决下。图片及源码如下：
1、这个程序主要的目的就是找到半径小于30的圆弧，并将它们的弧长统计后以表格形式写出（相同半径的圆弧，弧长相加后写出）：

2、我在在CAD2009为基础的天正道路软件上运行结果：

3、问题出现，在CAD2009和CAD2006上运行结果：

4、以下是测试用图和源码：


最后，感谢QQ群里【KAIXIN】的热心帮助！在下新手+业余，期待指导，再次感谢！

zyhandw

CAD2006中测试没问题，应该是运行前开了捕捉的问题

zyhandw

程序在设计时欠考虑！
可以在程序开始时，先用变量取得系统变量osmode的值，再(setvar "osmode" 0)关闭捕捉，程序最后再将系统变量osmode的值还原。

【KAIXIN】

设：没有捕捉，2004没问题，不过程序有待简化！

2. (princ "\n                   **********************Written by Cxg.**********************\n                   ********************Thanking for using!********************\n")
   
3. (defun c:bs (/ pt1 pt2 pt3 pt4 pt5 pt6 pt1a pt5a pt2a ww hh ss n m en obj r l pt11 pt22 pt33 pt44 pt55 pt66 pt11a pt55a pt22a ssr ssl enr_1 objr_1 r_1 l_1 l_sub enr_2 objr_2)
   
4.       (vl-load-com)
   
5. (setq mkj (getvar 'OSMODE))        ;提取捕捉
   
6. (setvar "osmode" 0)
   
7.       (setq acadobj (vlax-get-acad-object))
   
8.       (setq dwgobj (vla-get-activedocument acadobj))
   
9.       (setq mspace (vla-get-modelspace dwgobj))
   
10.       (setvar "cmdecho" 0)
    
11. ;---------------------------------------------------------------------------
    
12.       (setq pt11 (getpoint "\n插入统计表格左上角点:"))
    
13.       (setq ww (getdist pt11 "\n列宽<50>:"))
    
14.       (if (null ww) (setq ww 50.0))
    
15.       (setq hh (getdist pt11 "\n行高<6>:"))
    
16.       (if (null hh) (setq hh 6.0))
    
17.       (setq pt1 (polar pt11 pi ww))
    
18.       (setq pt2 (polar pt1 0 ww))
    
19.       (setq pt3 (polar pt2 (* pi 1.5) hh))
    
20.       (setq pt4 (polar pt1 (* pi 1.5) hh))
    
21.       (setq pt5 (polar pt1 0 (* 0.5 ww)))
    
22.       (setq pt6 (polar pt5 (* pi 1.5) hh))
    
23.       (setq pt1a pt1 pt5a pt5 pt2a pt2)
    
24.       (setq ss (ssget))
    
25.       (prompt "\n选择道路边线:")
    
26.       (if (null ss)
    
27.         (progn
    
28.             (alert "没有选择需要统计的对象！")
    
29.             (exit)
    
30.         )
    
31.       )
    
32.       (command "layer" "m" "边石统计" "c" "1" "" "")
    
33.       (command "pline" pt4 pt3 "")
    
34.       (command "text" "m" (inters pt1 pt6 pt4 pt5) 2.5 0 "半径(m)")
    
35.       (command "text" "m" (inters pt5 pt3 pt2 pt6) 2.5 0 "弧长(m)")
    
36.       (setq n 0 m 0)
    
37.       (repeat (sslength ss)
    
38.         (setq en (ssname ss n))
    
39.         (setq obj (vlax-ename->vla-object en))
    
40.         (if
    
41.             (= (vla-get-objectname obj) "AcDbArc")
    
42.             (if
    
43.                 (< (vla-get-radius obj) 30)
    
44.                 (progn
    
45.                     (setq r (rtos (vla-get-radius obj) 2 1))
    
46.                     (setq l (rtos (vla-get-arclength obj) 2 1))
    
47.                     (setq pt1 pt4 pt5 pt6 pt2 pt3)
    
48.                     (setq pt4 (polar pt1 (* pi 1.5) hh))
    
49.                     (setq pt6 (polar pt5 (* pi 1.5) hh))
    
50.                     (setq pt3 (polar pt2 (* pi 1.5) hh))
    
51.                     (command "pline" pt4 pt3 "")
    
52.                     (command "text" "m" (inters pt1 pt6 pt4 pt5) 2.5 0 r)
    
53.                     (command "text" "m" (inters pt5 pt3 pt2 pt6) 2.5 0 l)
    
54.                     (setq m (1+ m))
    
55.                 )
    
56.             )
    
57.         )
    
58.         (setq n (1+ n))
    
59.     )
    
60.     (setq ss (ssget "w" (polar pt1a (* pi 1.5) hh) pt6))
    
61.     (if (null ss)
    
62.             (progn
    
63.                         (command "erase" "w" pt1a pt3 "")
    
64.                         (alert "没有选择需要统计的对象！")
    
65.                 (exit)
    
66.         )
    
67.     )
    
68.     (command "pline" pt4 pt1a pt2a pt3 "")
    
69.     (command "pline" pt5a pt6 "")
    
70. ;---------------------------------------------------------------------------
    
71.     (setq pt22 (polar pt11 0 ww))
    
72.     (setq pt33 (polar pt22 (* pi 1.5) hh))
    
73.     (setq pt44 (polar pt11 (* pi 1.5) hh))
    
74.     (setq pt55 (polar pt11 0 (* 0.5 ww)))
    
75.     (setq pt66 (polar pt55 (* pi 1.5) hh))
    
76.     (setq pt11a pt11 pt55a pt55 pt22a pt22)
    
77.     (command "text" "m" (inters pt11 pt66 pt44 pt55) 2.5 0 "半径(m)")
    
78.     (command "text" "m" (inters pt55 pt33 pt22 pt66) 2.5 0 "弧长(m)")
    
79.     (command "pline" pt44 pt33 "")
    
80.     (setq ssr (ssget "w" (polar pt1a (* pi 1.5) hh)  pt6))
    
81.     (while ssr
    
82.       (setq ssr (ssget "w" (polar pt1a (* pi 1.5) hh)  pt6))
    
83.       (if ssr
    
84.               (progn
    
85.                   (setq ssl (ssget "w" (polar pt5a (* pi 1.5) hh)  pt3))
    
86.                   (setq enr_1 (ssname ssr 0))
    
87.                   (setq objr_1 (vlax-ename->vla-object enr_1))
    
88.                   (setq enl_1 (ssname ssl 0))
    
89.                   (setq  objl_1 (vlax-ename->vla-object enl_1))
    
90.                   (setq r_1 (vla-get-TextString objr_1) l_1 (vla-get-TextString objl_1))
    
91.                   (setq l_sub (atof l_1))
    
92.                   (vla-delete objr_1)
    
93.                   (vla-delete objl_1)
    
94.                   (setq a 1)
    
95.                   (repeat (- (sslength ssr) 1)
    
96.                           (setq enr_2 (ssname ssr a))
    
97.                           (setq objr_2 (vlax-ename->vla-object enr_2))
    
98.                           (setq enl_2 (ssname ssl a))
    
99.                           (setq objl_2 (vlax-ename->vla-object enl_2))
    
100.                           (if
     
101.                                   (= r_1 (vla-get-TextString objr_2))
     
102.                                   (progn
     
103.                                           (setq l_sub (+ l_sub (atof (vla-get-TextString objl_2))))
     
104.                                           (vla-delete objr_2)
     
105.                                           (vla-delete objl_2)
     
106.                                   )
     
107.                           )
     
108.                           (setq a (1+ a))
     
109.                   )
     
110.                   (setq pt11 pt44 pt55 pt66 pt22 pt33)
     
111.                   (setq pt44 (polar pt11 (* pi 1.5) hh))
     
112.                   (setq pt66 (polar pt55 (* pi 1.5) hh))
     
113.                   (setq pt33 (polar pt22 (* pi 1.5) hh))
     
114.                   (command "pline" pt44 pt33 "")
     
115.                   (command "text" "m" (inters pt11 pt66 pt44 pt55) 2.5 0 r_1)
     
116.                   (command "text" "m" (inters pt55 pt33 pt22 pt66) 2.5 0 (rtos l_sub 2 1))
     
117.                   )
     
118.                 )
     
119.         )
     
120.     (command "pline" pt44 pt11a pt22a pt33 "")
     
121.     (command "pline" pt55a pt66 "")
     
122.     (command "erase" "w" pt1a pt3 "")
     
123.     (command "zoom" "w" (polar pt11a (* 0.75 pi) 10) (polar pt33 (* 1.75 pi) 10) "")
     
124.     (command "PEDIT" "m" (polar pt11a 0 1) (polar pt44 0 1) "" "j" "" "")
     
125. (setvar "osmode" mkj)
     
126.     (princ)
     
127. )
     
128. ;---------------------------------------------------------------------------------------------

(princ "\n                   **********************Written by Cxg.**********************\n                   ********************Thanking for using!********************\n")<br /> (defun c:bs (/ pt1 pt2 pt3 pt4 pt5 pt6 pt1a pt5a pt2a ww hh ss n m en obj r l pt11 pt22 pt33 pt44 pt55 pt66 pt11a pt55a pt22a ssr ssl enr_1 objr_1 r_1 l_1 l_sub enr_2 objr_2)<br />       (vl-load-com)<br /> (setq mkj (getvar 'OSMODE))        ;提取捕捉<br /> (setvar "osmode" 0) <br />       (setq acadobj (vlax-get-acad-object))<br />       (setq dwgobj (vla-get-activedocument acadobj))<br />       (setq mspace (vla-get-modelspace dwgobj))<br />       (setvar "cmdecho" 0)<br /> ;---------------------------------------------------------------------------<br />       (setq pt11 (getpoint "\n插入统计表格左上角点:"))<br />       (setq ww (getdist pt11 "\n列宽<50>:"))<br />       (if (null ww) (setq ww 50.0))<br />       (setq hh (getdist pt11 "\n行高<6>:"))<br />       (if (null hh) (setq hh 6.0))<br />       (setq pt1 (polar pt11 pi ww))<br />       (setq pt2 (polar pt1 0 ww))<br />       (setq pt3 (polar pt2 (* pi 1.5) hh))<br />       (setq pt4 (polar pt1 (* pi 1.5) hh))<br />       (setq pt5 (polar pt1 0 (* 0.5 ww)))<br />       (setq pt6 (polar pt5 (* pi 1.5) hh))<br />       (setq pt1a pt1 pt5a pt5 pt2a pt2)<br />       (setq ss (ssget))<br />       (prompt "\n选择道路边线:")<br />       (if (null ss)<br />         (progn<br />             (alert "没有选择需要统计的对象！")<br />             (exit)<br />         )<br />       )<br />       (command "layer" "m" "边石统计" "c" "1" "" "")<br />       (command "pline" pt4 pt3 "")<br />       (command "text" "m" (inters pt1 pt6 pt4 pt5) 2.5 0 "半径(m)")<br />       (command "text" "m" (inters pt5 pt3 pt2 pt6) 2.5 0 "弧长(m)")<br />       (setq n 0 m 0)<br />       (repeat (sslength ss)<br />         (setq en (ssname ss n))<br />         (setq obj (vlax-ename->vla-object en))<br />         (if <br />             (= (vla-get-objectname obj) "AcDbArc")<br />             (if<br />                 (< (vla-get-radius obj) 30)<br />                 (progn<br />                     (setq r (rtos (vla-get-radius obj) 2 1))<br />                     (setq l (rtos (vla-get-arclength obj) 2 1))<br />                     (setq pt1 pt4 pt5 pt6 pt2 pt3)<br />                     (setq pt4 (polar pt1 (* pi 1.5) hh))<br />                     (setq pt6 (polar pt5 (* pi 1.5) hh))<br />                     (setq pt3 (polar pt2 (* pi 1.5) hh))<br />                     (command "pline" pt4 pt3 "")<br />                     (command "text" "m" (inters pt1 pt6 pt4 pt5) 2.5 0 r)<br />                     (command "text" "m" (inters pt5 pt3 pt2 pt6) 2.5 0 l)<br />                     (setq m (1+ m))<br />                 )<br />             )<br />         )<br />         (setq n (1+ n))<br />     )<br />     (setq ss (ssget "w" (polar pt1a (* pi 1.5) hh) pt6))<br />     (if (null ss)<br />             (progn<br />                         (command "erase" "w" pt1a pt3 "")<br />                         (alert "没有选择需要统计的对象！")<br />                 (exit)<br />         )<br />     )<br />     (command "pline" pt4 pt1a pt2a pt3 "")<br />     (command "pline" pt5a pt6 "")<br /> ;---------------------------------------------------------------------------<br />     (setq pt22 (polar pt11 0 ww))<br />     (setq pt33 (polar pt22 (* pi 1.5) hh))<br />     (setq pt44 (polar pt11 (* pi 1.5) hh))<br />     (setq pt55 (polar pt11 0 (* 0.5 ww)))<br />     (setq pt66 (polar pt55 (* pi 1.5) hh))<br />     (setq pt11a pt11 pt55a pt55 pt22a pt22)<br />     (command "text" "m" (inters pt11 pt66 pt44 pt55) 2.5 0 "半径(m)")<br />     (command "text" "m" (inters pt55 pt33 pt22 pt66) 2.5 0 "弧长(m)")<br />     (command "pline" pt44 pt33 "")<br />     (setq ssr (ssget "w" (polar pt1a (* pi 1.5) hh)  pt6))<br />     (while ssr<br />       (setq ssr (ssget "w" (polar pt1a (* pi 1.5) hh)  pt6))<br />       (if ssr<br />               (progn<br />                   (setq ssl (ssget "w" (polar pt5a (* pi 1.5) hh)  pt3))<br />                   (setq enr_1 (ssname ssr 0))<br />                   (setq objr_1 (vlax-ename->vla-object enr_1))<br />                   (setq enl_1 (ssname ssl 0))<br />                   (setq  objl_1 (vlax-ename->vla-object enl_1))<br />                   (setq r_1 (vla-get-TextString objr_1) l_1 (vla-get-TextString objl_1))<br />                   (setq l_sub (atof l_1))<br />                   (vla-delete objr_1)<br />                   (vla-delete objl_1)<br />                   (setq a 1)<br />                   (repeat (- (sslength ssr) 1)<br />                           (setq enr_2 (ssname ssr a))<br />                           (setq objr_2 (vlax-ename->vla-object enr_2))<br />                           (setq enl_2 (ssname ssl a))<br />                           (setq objl_2 (vlax-ename->vla-object enl_2))<br />                           (if<br />                                   (= r_1 (vla-get-TextString objr_2))<br />                                   (progn<br />                                           (setq l_sub (+ l_sub (atof (vla-get-TextString objl_2))))<br />                                           (vla-delete objr_2)<br />                                           (vla-delete objl_2)<br />                                   )<br />                           )<br />                           (setq a (1+ a))<br />                   )<br />                   (setq pt11 pt44 pt55 pt66 pt22 pt33)<br />                   (setq pt44 (polar pt11 (* pi 1.5) hh))<br />                   (setq pt66 (polar pt55 (* pi 1.5) hh))<br />                   (setq pt33 (polar pt22 (* pi 1.5) hh))<br />                   (command "pline" pt44 pt33 "")<br />                   (command "text" "m" (inters pt11 pt66 pt44 pt55) 2.5 0 r_1)<br />                   (command "text" "m" (inters pt55 pt33 pt22 pt66) 2.5 0 (rtos l_sub 2 1))<br />                   )<br />                 )<br />         )<br />     (command "pline" pt44 pt11a pt22a pt33 "")<br />     (command "pline" pt55a pt66 "")<br />     (command "erase" "w" pt1a pt3 "")<br />     (command "zoom" "w" (polar pt11a (* 0.75 pi) 10) (polar pt33 (* 1.75 pi) 10) "")<br />     (command "PEDIT" "m" (polar pt11a 0 1) (polar pt44 0 1) "" "j" "" "")<br /> (setvar "osmode" mkj) <br />     (princ)<br /> )<br /> ;---------------------------------------------------------------------------------------------

changxingge

zyhandw 发表于 2012-12-17 15:56
程序在设计时欠考虑！
可以在程序开始时，先用变量取得系统变量osmode的值，再(setvar "osmode" 0)关闭捕捉 ...

果然高手！十分感谢！！！！

changxingge

【KAIXIN】 发表于 2012-12-17 16:05
设：没有捕捉，2004没问题，不过程序有待简化！

嗯   程序的确该减肥   十分感谢！！！

zyhandw

changxingge 发表于 2012-12-17 16:09
果然高手！十分感谢！！！！

呵呵，见笑了，一点点小经验而已

changxingge

感谢G版指点，谢谢！