【已解决】怎么回事？

qyming2000 · 发表于 2019-3-9 17:09:48

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 qyming2000 于 2019-3-13 08:50 编辑

(defun addmenus (name lst / insertitem gemenubar menubar curmenu)
(defun insertitem (curmenu lst / k tmp x)
(setq k (vla-get-count curmenu))
(mapcar
'(lambda (x / label cmdstr)
(setq label (car x)
cmdstr (cadr x)
)
(cond
((= (type cmdstr) 'str)
(vla-addmenuitem
curmenu
(1+ (vla-get-count curmenu))
label
(strcat cmdstr (chr 32))
)
)
((= label "--") (vla-addseparator curmenu (1+ k)))
((listp cmdst)
(insertitem (vla-addsubmenu curmenu (1+ k) label) cmdstr)
)
)
)
lst
)
)
(defun getmenubar (str / curmenu menubar)
(setq menubar (vla-get-menubar (vlax-get-acad-object)))
(vlax-for menu menubar
(if (= (vla-get-name menu) str)
(setq curmenu menu)
)
)
curmenu
)
(setq menubar (vla-get-menubar (vlax-get-acad-object))
curmenu (getmenubar name)
)
(if (equal nil curmenu)
(progn
(setq curmenu
(vla-add
(vla-get-menus
(vla-item (vla-get-menugroups (vlax-get-acad-object))
0
)
)
name
)
)
(vla-insertinmenubar curmenu (1+ (vla-get-count menubar)))
)
)
(insertitem curmenu lst)
)
(addmenus "智能工具"
'(("初始化" "cass")
("--")
("野外测点" "zdh")
("展高程点" "zgcd")
("替代高程" "gcd2dot")
("填充符号" "fhxs")
("宗地工具"
(("调整宗地" "tzjzd")
("--")
("曲线换向" "lwpolyline")
)
)
("定位成果" "dwcqsj")
("拆迁成果" "hzcqsj")
("--")
("激活配置" "actp0")
("屏幕开关" "screenmmenu")
)
)
(addmenus "图层工具"
'(("图层关闭" "lay_off")
("图层全开" "lay_on")
("选层保留" "lay_0")
("--")
("图层冻结" "lay_fre")
("图层全消" "lay_off_all")
("--")
("图层锁定" "lay_shurt")
("图层解锁" "lay_shurt_on")
("图层反锁" "lay_shurt_")
("图层全解" "lay_shurt_all")
("--")
("置当前层" "re_lay")
("换至当前" "lay_1")
("图层批配" "lay_2")
("按层选中" "lay_3")
("--")
("选层前置" "lay_4")
("选层后置" "lay_5")
("填充后置" "lay_6")
("--")
("隐藏实体" "lay_7")
("隔离实体" "lay_8")
("恢复隐藏" "lay_9")
("--")
("结构图层" "lay_10")
("标准图层" "lay_11")
("图层面板" "lay_12")
("--")
("图层状态" "lay_13")
("图层浏览" "lay_14")
("图层删除" "lay_15")
("图层灰锁" "lay_16")
("图层合并" "lay_17")
)
)

(defun addmenus        (name lst / insertitem gemenubar menubar curmenu) 
  (defun insertitem (curmenu lst / k tmp x) 
    (setq k (vla-get-count curmenu)) 
    (mapcar 
      '(lambda (x / label cmdstr) 
         (setq label  (car x) 
               cmdstr (cadr x) 
         ) 
         (cond 
           ((= (type cmdstr) 'str) 
            (vla-addmenuitem 
              curmenu 
              (1+ (vla-get-count curmenu)) 
              label 
              (strcat cmdstr (chr 32)) 
            ) 
           ) 
           ((= label "--") (vla-addseparator curmenu (1+ k))) 
           ((listp cmdst) 
            (insertitem (vla-addsubmenu curmenu (1+ k) label) cmdstr) 
           ) 
         ) 
       ) 
      lst 
    ) 
  ) 
  (defun getmenubar (str / curmenu menubar) 
    (setq menubar (vla-get-menubar (vlax-get-acad-object))) 
    (vlax-for menu menubar 
      (if (= (vla-get-name menu) str) 
        (setq curmenu menu) 
      ) 
    ) 
    curmenu 
  ) 
  (setq        menubar        (vla-get-menubar (vlax-get-acad-object)) 
        curmenu        (getmenubar name) 
  ) 
  (if (equal nil curmenu) 
    (progn 
      (setq curmenu 
             (vla-add 
               (vla-get-menus 
                 (vla-item (vla-get-menugroups (vlax-get-acad-object)) 
                           0 
                 ) 
               ) 
               name 
             ) 
      ) 
      (vla-insertinmenubar curmenu (1+ (vla-get-count menubar))) 
    ) 
  ) 
  (insertitem curmenu lst) 
) 
(addmenus "智能工具" 
          '(("初始化" "cass") 
            ("--") 
            ("野外测点" "zdh") 
            ("展高程点" "zgcd") 
            ("替代高程" "gcd2dot") 
            ("填充符号" "fhxs") 
            ("宗地工具" 
             (("调整宗地" "tzjzd") 
              ("--") 
              ("曲线换向" "lwpolyline") 
             ) 
            ) 
            ("定位成果" "dwcqsj") 
            ("拆迁成果" "hzcqsj") 
            ("--") 
            ("激活配置" "actp0") 
            ("屏幕开关" "screenmmenu") 
           ) 
) 
(addmenus "图层工具" 
          '(("图层关闭" "lay_off") 
            ("图层全开" "lay_on") 
            ("选层保留" "lay_0") 
            ("--") 
            ("图层冻结" "lay_fre") 
            ("图层全消" "lay_off_all") 
            ("--") 
            ("图层锁定" "lay_shurt") 
            ("图层解锁" "lay_shurt_on") 
            ("图层反锁" "lay_shurt_") 
            ("图层全解" "lay_shurt_all") 
            ("--") 
            ("置当前层" "re_lay") 
            ("换至当前" "lay_1") 
            ("图层批配" "lay_2") 
            ("按层选中" "lay_3") 
            ("--") 
            ("选层前置" "lay_4") 
            ("选层后置" "lay_5") 
            ("填充后置" "lay_6") 
            ("--") 
            ("隐藏实体" "lay_7") 
            ("隔离实体" "lay_8") 
            ("恢复隐藏" "lay_9") 
            ("--") 
            ("结构图层" "lay_10") 
            ("标准图层" "lay_11") 
            ("图层面板" "lay_12") 
            ("--") 
            ("图层状态" "lay_13") 
            ("图层浏览" "lay_14") 
            ("图层删除" "lay_15") 
            ("图层灰锁" "lay_16") 
            ("图层合并" "lay_17") 
           ) 
)

第二个分隔重叠在一起，找不到原因

newer · 发表于 2019-3-9 17:32:51

这问题，问的无头无尾啊，你想做什么？

qyming2000 · 发表于 2019-3-10 08:23:05

本帖最后由 qyming2000 于 2019-3-10 08:31 编辑

newer 发表于 2019-3-9 17:32
这问题，问的无头无尾啊，你想做什么？

这样？？？？？？

marting · 发表于 2019-3-10 14:50:06

别用K做递增变量，开始保存K到J，递增J，就行了

QQ截图20190310144844.png

(defun addmenus (name lst / insertitem gemenubar menubar curmenu)
(defun insertitem (curmenu lst / k tmp x j)
(setq k (vla-get-count curmenu)
j k)
(mapcar '(lambda (x / label cmdstr)
(setq label (car x)
cmdstr (cadr x)
)
(cond ((= (type cmdstr) 'str)
(vla-addmenuitem
curmenu
(1+ (vla-get-count curmenu))
label
(strcat cmdstr (chr 32))
)
)
((= label "--") (vla-addseparator curmenu (1+ j)))
((listp cmdst)
(insertitem (vla-addsubmenu curmenu (1+ j) label) cmdstr)
)
)
(setq j (1+ j))
)
lst
)
)
(defun getmenubar (str / curmenu menubar)
(setq menubar (vla-get-menubar (vlax-get-acad-object)))
(vlax-for menu menubar
(if (= (vla-get-name menu) str)
(setq curmenu menu)
)
)
curmenu
)
(setq menubar (vla-get-menubar (vlax-get-acad-object))
curmenu (getmenubar name)
)
(if (equal nil curmenu)
(progn (setq curmenu (vla-add (vla-get-menus
(vla-item (vla-get-menugroups (vlax-get-acad-object)) 0)
)
name
)
)
(vla-insertinmenubar curmenu (1+ (vla-get-count menubar)))
)
)
(insertitem curmenu lst)
)

(defun addmenus (name lst / insertitem gemenubar menubar curmenu) 
  (defun insertitem (curmenu lst / k tmp x j) 
    (setq k (vla-get-count curmenu) 
          j k) 
    (mapcar '(lambda (x / label cmdstr) 
               (setq label  (car x) 
                     cmdstr (cadr x) 
               ) 
               (cond ((= (type cmdstr) 'str) 
                      (vla-addmenuitem 
                        curmenu 
                        (1+ (vla-get-count curmenu)) 
                        label 
                        (strcat cmdstr (chr 32)) 
                      ) 
                     ) 
                     ((= label "--") (vla-addseparator curmenu (1+ j))) 
                     ((listp cmdst) 
                      (insertitem (vla-addsubmenu curmenu (1+ j) label) cmdstr) 
                     ) 
               ) 
               (setq j (1+ j)) 
             ) 
            lst 
    ) 
  ) 
  (defun getmenubar (str / curmenu menubar) 
    (setq menubar (vla-get-menubar (vlax-get-acad-object))) 
    (vlax-for menu menubar 
      (if (= (vla-get-name menu) str) 
        (setq curmenu menu) 
      ) 
    ) 
    curmenu 
  ) 
  (setq menubar (vla-get-menubar (vlax-get-acad-object)) 
        curmenu (getmenubar name) 
  ) 
  (if (equal nil curmenu) 
    (progn (setq curmenu (vla-add (vla-get-menus 
                                    (vla-item (vla-get-menugroups (vlax-get-acad-object)) 0) 
                                  ) 
                                  name 
                         ) 
           ) 
           (vla-insertinmenubar curmenu (1+ (vla-get-count menubar))) 
    ) 
  ) 
  (insertitem curmenu lst) 
)

qyming2000 · 发表于 2019-3-10 17:59:50

qyming2000 · 发表于 2019-3-10 18:00:53

newer · 发表于 2019-3-10 20:31:20

qyming2000 发表于 2019-3-10 17:59
OK,

解决了，请编辑下主题，标题前面粘贴上【已解决】

sicky111 · 发表于 2019-3-11 00:04:06

菜单还可以这样写

账号		自动登录	找回密码
密码			立即注册

[已解决] 【已解决】怎么回事？

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评