【已解决】大神帮忙了

qyming2000

下面这个正常

1. (defun c:anniu1        (/                listtoolbars   bitname1
   
2.                  bitname2        bitname3       currmenugroup
   
3.                  index1                index2               index3
   
4.                  macro1                macro2               macro3
   
5.                  name1                name2               name3
   
6.                  newtoolbar        newtoolbarbutton1
   
7.                  newtoolbarbutton2               newtoolbarbutton3
   
8.                  newtoolbarsel
   
9.                 )
   
10.   (defun listtoolbars (groupname / mgroups mgroup lst)
    
11.     (if        (not
    
12.           (vl-catch-all-error-p
    
13.             (setq mgroup
    
14.                    (vl-catch-all-apply
    
15.                      'vla-item
    
16.                      (list (vla-get-menugroups (vlax-get-acad-object))
    
17.                            groupname
    
18.                      )
    
19.                    )
    
20.             )
    
21.           )
    
22.         )
    
23.       (vlax-for        tbar (vla-get-toolbars mgroup)
    
24.         (setq lst (cons (vla-get-name tbar) lst))
    
25.       )
    
26.     )
    
27.   )
    
28.   (setq        currmenugroup
    
29.          (vla-item (vla-get-menugroups (vlax-get-acad-object))
    
30.                    0
    
31.          )
    
32.   )
    
33.   (if (and (= (vl-position "经纬仪" (listtoolbars "acad")) nil)
    
34.            (= (vl-position "经纬仪" (listtoolbars "custom")) nil)
    
35.       )
    
36.     (progn
    
37.       (setq newtoolbarsel (vla-get-toolbars currmenugroup))
    
38.       (setq newtoolbar (vla-add newtoolbarsel "经纬仪"))
    
39.       (setq macro1
    
40.              (strcat (chr 3) (chr 3) (chr 95) "zjfy" (chr 32))
    
41.       )
    
42.       (setq macro2
    
43.              (strcat (chr 3) (chr 3) (chr 95) "txbh" (chr 32))
    
44.       )
    
45.       (setq macro3
    
46.              (strcat (chr 3) (chr 3) (chr 95) "jdhz" (chr 32))
    
47.       )
    
48.       (setq index1 0
    
49.             index2 1
    
50.             index3 2
    
51.       )
    
52.       (setq name1 "桩机放样")
    
53.       (setq name2 "图形编号")
    
54.       (setq name3 "基点绘制")
    
55.       (setq newtoolbarbutton1
    
56.              (vla-addtoolbarbutton
    
57.                newtoolbar index1 name1 name1 macro1)
    
58.       )
    
59.       (setq newtoolbarbutton2
    
60.              (vla-addtoolbarbutton
    
61.                newtoolbar index2 name2 name2 macro2)
    
62.       )
    
63.       (setq newtoolbarbutton3
    
64.              (vla-addtoolbarbutton
    
65.                newtoolbar index3 name3 name3 macro3)
    
66.       )
    
67.       (setq bitname1 "c:\\temp\\zhuangji.ico")
    
68.       (setq bitname2 "c:\\temp\\zwbh.ico")
    
69.       (setq bitname3 "c:\\temp\\hui.ico")
    
70.       (vla-setbitmaps newtoolbarbutton1 bitname1 bitname1)
    
71.       (vla-setbitmaps newtoolbarbutton2 bitname2 bitname2)
    
72.       (vla-setbitmaps newtoolbarbutton3 bitname3 bitname3)
    
73.       (vla-put-visible newtoolbar :vlax-true)
    
74.     )
    
75.   )
    
76.   (princ)
    
77. )

(defun c:anniu1        (/                listtoolbars   bitname1<br />                  bitname2        bitname3       currmenugroup<br />                  index1                index2               index3<br />                  macro1                macro2               macro3<br />                  name1                name2               name3<br />                  newtoolbar        newtoolbarbutton1<br />                  newtoolbarbutton2               newtoolbarbutton3<br />                  newtoolbarsel<br />                 )<br />   (defun listtoolbars (groupname / mgroups mgroup lst)<br />     (if        (not<br />           (vl-catch-all-error-p<br />             (setq mgroup<br />                    (vl-catch-all-apply<br />                      'vla-item<br />                      (list (vla-get-menugroups (vlax-get-acad-object))<br />                            groupname<br />                      )<br />                    )<br />             )<br />           )<br />         )<br />       (vlax-for        tbar (vla-get-toolbars mgroup)<br />         (setq lst (cons (vla-get-name tbar) lst))<br />       )<br />     )<br />   )<br />   (setq        currmenugroup<br />          (vla-item (vla-get-menugroups (vlax-get-acad-object))<br />                    0<br />          )<br />   )<br />   (if (and (= (vl-position "经纬仪" (listtoolbars "acad")) nil)<br />            (= (vl-position "经纬仪" (listtoolbars "custom")) nil)<br />       )<br />     (progn<br />       (setq newtoolbarsel (vla-get-toolbars currmenugroup))<br />       (setq newtoolbar (vla-add newtoolbarsel "经纬仪"))<br />       (setq macro1<br />              (strcat (chr 3) (chr 3) (chr 95) "zjfy" (chr 32))<br />       )<br />       (setq macro2<br />              (strcat (chr 3) (chr 3) (chr 95) "txbh" (chr 32))<br />       )<br />       (setq macro3<br />              (strcat (chr 3) (chr 3) (chr 95) "jdhz" (chr 32))<br />       )<br />       (setq index1 0<br />             index2 1<br />             index3 2<br />       )<br />       (setq name1 "桩机放样")<br />       (setq name2 "图形编号")<br />       (setq name3 "基点绘制")<br />       (setq newtoolbarbutton1<br />              (vla-addtoolbarbutton<br />                newtoolbar index1 name1 name1 macro1)<br />       )<br />       (setq newtoolbarbutton2<br />              (vla-addtoolbarbutton<br />                newtoolbar index2 name2 name2 macro2)<br />       )<br />       (setq newtoolbarbutton3<br />              (vla-addtoolbarbutton<br />                newtoolbar index3 name3 name3 macro3)<br />       )<br />       (setq bitname1 "c:\\temp\\zhuangji.ico")<br />       (setq bitname2 "c:\\temp\\zwbh.ico")<br />       (setq bitname3 "c:\\temp\\hui.ico")<br />       (vla-setbitmaps newtoolbarbutton1 bitname1 bitname1)<br />       (vla-setbitmaps newtoolbarbutton2 bitname2 bitname2)<br />       (vla-setbitmaps newtoolbarbutton3 bitname3 bitname3)<br />       (vla-put-visible newtoolbar :vlax-true)<br />     )<br />   )<br />   (princ)<br /> )

这个出错

1. (defun c:anniu2 (/              listtoolbars  bitname          currmenugroup
   
2.                 index              lst            name          name1
   
3.                 newtoolbar    newtoolbarbutton                  newtoolbarsel
   
4.                 macro
   
5.                )
   
6.   (defun listtoolbars (groupname / mgroups mgroup lst)
   
7.     (if        (not
   
8.           (vl-catch-all-error-p
   
9.             (setq mgroup
   
10.                    (vl-catch-all-apply
    
11.                      'vla-item
    
12.                      (list (vla-get-menugroups (vlax-get-acad-object))
    
13.                            groupname
    
14.                      )
    
15.                    )
    
16.             )
    
17.           )
    
18.         )
    
19.       (vlax-for        tbar (vla-get-toolbars mgroup)
    
20.         (setq lst (cons (vla-get-name tbar) lst))
    
21.       )
    
22.     )
    
23.   )
    
24.   (setq        currmenugroup
    
25.          (vla-item (vla-get-menugroups (vlax-get-acad-object))
    
26.                    0
    
27.          )
    
28.   )
    
29.   (if (and (= (vl-position "经纬仪4" (listtoolbars "acad")) nil)
    
30.            (= (vl-position "经纬仪4" (listtoolbars "custom")) nil)
    
31.       )
    
32.     (progn
    
33.       (setq newtoolbarsel (vla-get-toolbars currmenugroup))
    
34.       (setq newtoolbar (vla-add newtoolbarsel "经纬仪4"))
    
35.       (setq lst        '(("桩机放样" "zjfy" "c:\\temp\\zhuangji.ico")
    
36.                   ("图形编号" "txbh" "c:\\temp\\zwbh.ico")
    
37.                   ("基点绘制" "jdhz" "c:\\temp\\hui.ico")
    
38.                  )
    
39.       )
    
40.       (setq index 0)
    
41.       (foreach x lst
    
42.         (setq name    (car x)
    
43.               macro   (cadr x)
    
44.               bitname (caddr x)
    
45.         )
    
46.         (setq newtoolbarbutton
    
47.                (vla-addtoolbarbutton
    
48.                  newtoolbar
    
49.                  index
    
50.                  name
    
51.                  name
    
52.                  (strcat (chr 3) (chr 3) (chr 95) macro (chr 95))
    
53.                )
    
54.         )
    
55.         (vla-setbitmaps newtoolbarbutton bitname bitname)
    
56.         (setq index (1+ index))
    
57.       )
    
58. 
    
59.       (vla-put-visible newtoolbar :vlax-true)
    
60.     )
    
61.   )
    
62.   (princ)
    
63. )

(defun c:anniu2 (/              listtoolbars  bitname          currmenugroup<br />                 index              lst            name          name1<br />                 newtoolbar    newtoolbarbutton                  newtoolbarsel<br />                 macro<br />                )<br />   (defun listtoolbars (groupname / mgroups mgroup lst)<br />     (if        (not<br />           (vl-catch-all-error-p<br />             (setq mgroup<br />                    (vl-catch-all-apply<br />                      'vla-item<br />                      (list (vla-get-menugroups (vlax-get-acad-object))<br />                            groupname<br />                      )<br />                    )<br />             )<br />           )<br />         )<br />       (vlax-for        tbar (vla-get-toolbars mgroup)<br />         (setq lst (cons (vla-get-name tbar) lst))<br />       )<br />     )<br />   )<br />   (setq        currmenugroup<br />          (vla-item (vla-get-menugroups (vlax-get-acad-object))<br />                    0<br />          )<br />   )<br />   (if (and (= (vl-position "经纬仪4" (listtoolbars "acad")) nil)<br />            (= (vl-position "经纬仪4" (listtoolbars "custom")) nil)<br />       )<br />     (progn<br />       (setq newtoolbarsel (vla-get-toolbars currmenugroup))<br />       (setq newtoolbar (vla-add newtoolbarsel "经纬仪4"))<br />       (setq lst        '(("桩机放样" "zjfy" "c:\\temp\\zhuangji.ico")<br />                   ("图形编号" "txbh" "c:\\temp\\zwbh.ico")<br />                   ("基点绘制" "jdhz" "c:\\temp\\hui.ico")<br />                  )<br />       )<br />       (setq index 0)<br />       (foreach x lst<br />         (setq name    (car x)<br />               macro   (cadr x)<br />               bitname (caddr x)<br />         )<br />         (setq newtoolbarbutton<br />                (vla-addtoolbarbutton<br />                  newtoolbar<br />                  index<br />                  name<br />                  name<br />                  (strcat (chr 3) (chr 3) (chr 95) macro (chr 95))<br />                )<br />         )<br />         (vla-setbitmaps newtoolbarbutton bitname bitname)<br />         (setq index (1+ index))<br />       )<br /> <br />       (vla-put-visible newtoolbar :vlax-true)<br />     )<br />   )<br />   (princ)<br /> )

第一段代码运行正常，第二段出现问题，知识不够，大神们帮帮忙调试

newer

楼主，怎么解决的？

qyming2000

用了牢固大神的一个函数，我也不明白是什么原理
来自: 微社区

newer

qyming2000 发表于 2019-3-16 22:37
用了牢固大神的一个函数，我也不明白是什么原理

哪个函数啊，贴出来啊。

qyming2000

newer 发表于 2019-3-17 00:09
哪个函数啊，贴出来啊。

1. (defun addToolbars (toolbarname         lst              /
   
2.                     gxl-catchapply              bitname           toolbars
   
3.                     index         lst              name           name1
   
4.                     newtoolbar         newtoolbarbutton           macro
   
5.                    )
   
6.   (defun gxl-catchapply        (fun args / result)
   
7.     (if        (not (vl-catch-all-error-p
   
8.                (setq result
   
9.                       (vl-catch-all-apply
   
10.                         (if (= 'sym (type fun))
    
11.                           fun
    
12.                           (function fun)
    
13.                         )
    
14.                         args
    
15.                       )
    
16.                )
    
17.              )
    
18.         )
    
19.       result
    
20.     )
    
21.   )
    
22.   (setq        toolbars
    
23.          (vla-get-toolbars
    
24.            (vla-item (vla-get-menugroups (vlax-get-acad-object))
    
25.                      0
    
26.            )
    
27.          )
    
28.   )
    
29.   (if (setq newtoolbar
    
30.              (gxl-catchapply
    
31.                vla-item
    
32.                (list toolbars toolbarname)
    
33.              )
    
34.       )
    
35.     (vla-delete newtoolbar)
    
36.   )
    
37.   (setq newtoolbar (vla-add toolbars toolbarname))
    
38.   (foreach x lst
    
39.     (setq index          0
    
40.           name          (car x)
    
41.           macro          (cadr x)
    
42.           bitname (caddr x)
    
43.     )
    
44.     (cond ((= name "--") (vla-addseparator newtoolbar (1+ index)))
    
45.           (t
    
46.            (setq newtoolbarbutton
    
47.                   (gxl-catchapply
    
48.                     vla-addtoolbarbutton
    
49.                     (list newtoolbar
    
50.                           index
    
51.                           name
    
52.                           name
    
53.                           (strcat (chr 32) (chr 32) (chr 95) macro (chr 32))
    
54.                     )
    
55.                   )
    
56.            )
    
57.            (gxl-catchapply
    
58.              vla-setbitmaps
    
59.              (list newtoolbarbutton bitname bitname)
    
60.            )
    
61.           )
    
62.     )
    
63.     (setq index (1+ index))
    
64.   )
    
65.   (vla-put-visible newtoolbar :vlax-true)
    
66.   (princ)
    
67. )
    
68. ;|
    
69. (addToolbars   "文字工具3"
    
70.   '(("文字合并" "wzhb" "wwzhb.ico")
    
71.     ("文字对齐" "wzdq" "wwzdq.ico")
    
72.         ("--")
    
73.     ("文字编号" "wzbh" "wwzbh.ico")
    
74.    )
    
75. )

(defun addToolbars (toolbarname         lst              /<br />                     gxl-catchapply              bitname           toolbars<br />                     index         lst              name           name1<br />                     newtoolbar         newtoolbarbutton           macro<br />                    )<br />   (defun gxl-catchapply        (fun args / result)<br />     (if        (not (vl-catch-all-error-p<br />                (setq result<br />                       (vl-catch-all-apply<br />                         (if (= 'sym (type fun))<br />                           fun<br />                           (function fun)<br />                         )<br />                         args<br />                       )<br />                )<br />              )<br />         )<br />       result<br />     )<br />   )<br />   (setq        toolbars<br />          (vla-get-toolbars<br />            (vla-item (vla-get-menugroups (vlax-get-acad-object))<br />                      0<br />            )<br />          )<br />   )<br />   (if (setq newtoolbar<br />              (gxl-catchapply<br />                vla-item<br />                (list toolbars toolbarname)<br />              )<br />       )<br />     (vla-delete newtoolbar)<br />   )<br />   (setq newtoolbar (vla-add toolbars toolbarname))<br />   (foreach x lst<br />     (setq index          0<br />           name          (car x)<br />           macro          (cadr x)<br />           bitname (caddr x)<br />     )<br />     (cond ((= name "--") (vla-addseparator newtoolbar (1+ index)))<br />           (t<br />            (setq newtoolbarbutton<br />                   (gxl-catchapply<br />                     vla-addtoolbarbutton<br />                     (list newtoolbar<br />                           index<br />                           name<br />                           name<br />                           (strcat (chr 32) (chr 32) (chr 95) macro (chr 32))<br />                     )<br />                   )<br />            )<br />            (gxl-catchapply<br />              vla-setbitmaps<br />              (list newtoolbarbutton bitname bitname)<br />            )<br />           )<br />     )<br />     (setq index (1+ index))<br />   )<br />   (vla-put-visible newtoolbar :vlax-true)<br />   (princ)<br /> )<br /> ;|<br /> (addToolbars   "文字工具3"<br />   '(("文字合并" "wzhb" "wwzhb.ico")<br />     ("文字对齐" "wzdq" "wwzdq.ico")<br />         ("--")<br />     ("文字编号" "wzbh" "wwzbh.ico")<br />    )<br /> )

sicky111

这个功能是做什么用的？

coverne

牢固大神的一个函数？