求帮忙添加板面按键与功能函数链接函数（此前看到一个前辈发的批量操作希望实现功能）

dami

(defun LM:GetFiles


    (
        title default ext


        /


        *error*
        _PopulateListBox
        _GetFiles
        _BrowseForFolder
        _Full->Relative
        _str->lst
        _UpdateFileList
        _UpdateSelected
        _UpDir
        _FixDir


        data dir filename files id openfile result
    )


    (defun *error* ( msg )
        (if (< 0 id) (unload_dialog id))
        (if (and filename (findfile filename)) (vl-file-delete filename))
        (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )


    (defun _PopulateListBox ( key lst )
        (start_list key)
        (foreach item lst (add_list item))
        (end_list)
        lst
    )


    (defun _GetFiles ( dir ext files )
        (vl-remove-if
            (function (lambda ( file ) (member (strcat dir "\\" file) files)))
            (cond
                (   (cdr (assoc dir data))   )
                (   (cdar
                        (setq data
                            (cons
                                (cons dir
                                    (append
                                        (vl-sort (vl-remove "." (vl-directory-files dir nil -1)) '<)
                                        (if (member ext '(("") ("*")))
                                            (vl-directory-files dir nil 1)
                                            (vl-sort
                                                (vl-remove-if-not
                                                    (function
                                                        (lambda ( file / extn )
                                                            (and
                                                                (setq extn (vl-filename-extension file))
                                                                (setq extn (strcase (substr extn 2)))
                                                                (vl-some
                                                                    (function (lambda ( wc ) (wcmatch extn wc)))
                                                                    ext
                                                                )
                                                            )
                                                        )
                                                    )
                                                    (vl-directory-files dir nil 1)
                                                )
                                                (function
                                                    (lambda ( a b )
                                                        (<
                                                            (vl-filename-extension a)
                                                            (vl-filename-extension b)
                                                        )
                                                    )
                                                )
                                            )
                                        )
                                    )
                                )
                                data
                            )
                        )
                    )
                )
            )
        )
    )


    (defun _BrowseForFolder ( msg dir flag / err shell fold self path )
        (setq err
            (vl-catch-all-apply
                (function
                    (lambda ( / acapp hwnd )
                        (if (setq acapp (vlax-get-acad-object)
                                  shell (vla-getinterfaceobject acapp "Shell.Application")
                                  hwnd  (vl-catch-all-apply 'vla-get-hwnd (list acapp))
                                  fold  (vlax-invoke-method shell 'BrowseForFolder (if (vl-catch-all-error-p hwnd) 0 hwnd) msg flag dir)
                            )
                            (setq self (vlax-get-property fold 'self)
                                  path (vlax-get-property self 'path)
                                  path (vl-string-right-trim "\\" (vl-string-translate "/" "\\" path))
                            )
                        )
                    )
                )
            )
        )
        (if self  (vlax-release-object  self))
        (if fold  (vlax-release-object  fold))
        (if shell (vlax-release-object shell))
        (if (vl-catch-all-error-p err)
            (prompt (vl-catch-all-error-message err))
            path
        )
    )


    (defun _Full->Relative ( dir path / p q )
        (setq dir (vl-string-right-trim "\\" dir))
        (cond
            (   (and
                    (setq p (vl-string-position 58  dir))
                    (setq q (vl-string-position 58 path))
                    (not (eq (strcase (substr dir 1 p)) (strcase (substr path 1 q))))
                )
                path
            )
            (   (and
                    (setq p (vl-string-position 92  dir))
                    (setq q (vl-string-position 92 path))
                    (eq (strcase (substr dir 1 p)) (strcase (substr path 1 q)))
                )
                (_Full->Relative (substr dir (+ 2 p)) (substr path (+ 2 q)))
            )
            (   (and
                    (setq q (vl-string-position 92 path))
                    (eq (strcase dir) (strcase (substr path 1 q)))
                )
                (strcat ".\\" (substr path (+ 2 q)))
            )
            (   (eq "" dir)
                path
            )
            (   (setq p (vl-string-position 92 dir))
                (_Full->Relative (substr dir (+ 2 p)) (strcat "..\\" path))
            )
            (   (_Full->Relative "" (strcat "..\\" path)))
        )
    )


    (defun _str->lst ( str del / pos )
        (if (setq pos (vl-string-search del str))
            (cons (substr str 1 pos) (_str->lst (substr str (+ pos 1 (strlen del))) del))
            (list str)
        )
    )


    (defun _UpdateFileList ( dir ext files )
        (_PopulateListBox "box1" (_GetFiles dir ext files))
    )


    (defun _UpdateSelected ( dir files )
        (_PopulateListBox "box2" (mapcar (function (lambda ( file ) (_Full->Relative dir file))) files))
        files
    )


    (defun _UpDir ( dir )
        (substr dir 1 (vl-string-position 92 dir nil t))
    )


    (defun _FixDir ( dir )
        (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir))
    )
   
    (cond
        (
            (not
                (and
                    (setq filename (vl-filename-mktemp nil nil ".dcl"))
                    (setq openfile (open filename "w"))
                    (progn
                        (foreach line
                           '(
                                "listbox : list_box { width = 40; height =  20; fixed_width = true; fixed_height = true;"
                                "                     alignment = centered; multiple_select = true; }"
                                "abutton : button   { width = 20; height = 1.8; fixed_width = true; fixed_height = true;"
                                "                     alignment = centered; }"
                                ""
                                "getfiles : dialog { key = \"title\"; spacer;"
                                "    : row { alignment = centered;"
                                "        : edit_box { key = \"directory\"; label = \"文件夹:\"; }"
                                "        : button   { key = \"browse\"; label = \"浏览\"; fixed_width = true; }"
                                "    }"
                                "    spacer;"
                              
                                ;;//添加命令
                                "    :boxed_radio_row {"
                                ;"          label="选择操作内容";
                                "          :radio_button{label=\"批量清理\" ; key = \"ea\" ;  }"
                                "          :radio_button{label=\"批量绑定\" ;key = \"eb\" ;  }"     
                                "          :radio_button{label=\"批量关非打印图层\" ;  key = \"ec\" ; }"  
                                "          :radio_button{label=\"批量颜色随层\" ;  key = \"ed\" ; }"  
                                                         
                                "        }"                                
                                "    spacer;"                                
                                
                                
                                "    : row {"
                                "        : column {"
                                "            : listbox { key = \"box1\"; }"
                                "            : abutton { key = \"add\" ; label = \"添加文件\"; }"
                                "        }"
                                "        : column {"
                                "            : listbox { key = \"box2\"; }"
                                "            : abutton { key = \"del\" ; label = \"删除文件\"; }"
                                "        }"
                                "    }"
                                "    spacer; ok_cancel;"
                                "}"
                            )
                            (write-line line openfile)
                        )
                        (close openfile)
                        (< 0 (setq id (load_dialog filename)))
                    )
                    (new_dialog "getfiles" id)
                )
            )
        )
        (   t
            (setq ext (_str->lst (strcase ext) ";"))
            (set_tile "title" (if (eq "" title) "Select Files" title))
            (set_tile "directory"
                (setq dir
                    (_FixDir
                        (if
                            (or
                                (eq "" default)
                                (null (vl-file-directory-p (_FixDir default)))
                             )
                             (getvar 'DWGPREFIX)
                             default
                        )
                    )
                )
            )
            (setq files (_UpdateFileList dir ext nil))
            (mode_tile "add" 1)
            (mode_tile "del" 1)


            (action_tile "browse"
                (vl-prin1-to-string
                   '(if (setq tmp    (_BrowseForFolder "" nil 512))
                        (setq files  (_UpdateFileList (set_tile "directory" (setq dir tmp)) ext result)
                              result (_UpdateSelected dir result)
                        )                              
                    )
                )
            )


            (action_tile "directory"
                (vl-prin1-to-string
                   '(if (= 1 $reason)
                        (setq files  (_UpdateFileList (set_tile "directory" (setq dir (_FixDir $value))) ext result)
                              result (_UpdateSelected dir result)
                        )
                    )
                )
            )


            (action_tile "box1"
                (vl-prin1-to-string
                   '(
                        (lambda ( / items tmp )
                            (setq items
                                (mapcar
                                    (function (lambda ( n ) (nth n files)))
                                    (read (strcat "(" $value ")"))
                                )
                            )
                            (if (= 4 $reason)
                                (cond
                                    (   (equal '("..") items)
                                        (setq files  (_UpdateFileList (set_tile "directory" (setq dir (_UpDir dir))) ext result)
                                              result (_UpdateSelected dir result)
                                        )
                                    )
                                    (   (and
                                            (null (vl-filename-extension (car items)))
                                            (vl-file-directory-p (setq tmp (strcat dir "\\" (car items))))
                                        )
                                        (setq files  (_UpdateFileList (set_tile "directory" (setq dir tmp)) ext result)
                                              result (_UpdateSelected dir result)
                                        )
                                    )
                                    (   t                                    
                                        (setq result (_UpdateSelected dir (vl-sort (append result (mapcar '(lambda ( file ) (strcat dir "\\" file)) items)) '<))
                                              files  (_UpdateFileList dir ext result)
                                        )
                                    )
                                )
                                (if (vl-some (function (lambda ( item ) (vl-filename-extension item))) items)
                                    (mode_tile "add" 0)
                                )
                            )
                        )
                    )
                )
            )


            (action_tile "box2"
                (vl-prin1-to-string
                   '(
                        (lambda ( / items )
                            (setq items
                                (mapcar
                                    (function (lambda ( n ) (nth n result)))
                                    (read (strcat "(" $value ")"))
                                )
                            )
                            (if (= 4 $reason)
                                (setq result (_UpdateSelected dir (vl-remove (car items) result))
                                      files  (_UpdateFileList dir ext result)
                                )
                                (mode_tile "del" 0)
                            )
                        )
                    )
                )
            )


            (action_tile "add"
                (vl-prin1-to-string
                   '(
                        (lambda ( / items )
                            (if (setq items
                                    (vl-remove-if-not
                                        (function (lambda ( file ) (vl-filename-extension file)))
                                        (mapcar
                                            (function (lambda ( n ) (nth n files)))
                                            (read (strcat "(" (get_tile "box1") ")"))
                                        )
                                    )
                                )
                                (setq result (_UpdateSelected dir (vl-sort (append result (mapcar '(lambda ( file ) (strcat dir "\\" file)) items)) '<))
                                      files  (_UpdateFileList dir ext result)
                                )
                            )
                            (mode_tile "add" 1)
                            (mode_tile "del" 1)
                        )
                    )
                )
            )


            (action_tile "del"
                (vl-prin1-to-string
                   '(
                        (lambda ( / items )
                            (if
                                (setq items
                                    (mapcar
                                        (function (lambda ( n ) (nth n result)))
                                        (read (strcat "(" (get_tile "box2") ")"))
                                    )
                                )
                                (setq result (_UpdateSelected dir (vl-remove-if (function (lambda ( file ) (member file items))) result))
                                      files  (_UpdateFileList dir ext result)
                                )
                            )
                            (mode_tile "add" 1)
                            (mode_tile "del" 1)
                        )
                    )
                )
            )
         
            (if (zerop (start_dialog))
                (setq result nil)
            )
        )
    )
    (if (< 0 id)
        (unload_dialog id)
    )
    (if (and filename (findfile filename))
        (vl-file-delete filename)
    )
    result
)








;; 作者：秋枫，参考了灯火的VBA程序
;; 用法：(qf_getFolder message)
;; 例子：(qf_getFolder "选择文件夹:")
;; 返回值：字符串，文件夹路径，如果点了cancel, 返回nil
　
(defun getFolder (message / WinShell shFolder path catchit)
  (vl-load-com)
  (setq winshell (vlax-create-object "Shell.Application"))
  (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 message 1))
  (setq
    catchit (vl-catch-all-apply
       '(lambda ()
   (setq shFolder (vlax-get-property shFolder 'self))
   (setq path (vlax-get-property shFolder 'path))
        )
     )
  )
  (if (vl-catch-all-error-p catchit)
    nil
    path
  )
)












;;;以下程序为批量绑定的主程序
(defun c:1698 ( )
   (setvar "cmdecho" 0)
  (vl-load-com)
  (setq        sfiles
         (LM:GetFiles
           "选择处理的文件                     批量清理 "
           (getvar "dwgprefix")
           "dwg"
         )
  )
   (dcl_1698)


  (setvar "cmdecho" 1)
  (prin1)
)
  
  
  
  
  
  
(defun dcl_1698 ( )  








;(SETQ CHULI "ea206")
;(set_tile CHULI "1")
;(SETQ NAME (GET_ATTR CHULI "LABEL"))






(setq   chuli1 (atof (get_tile "ea"))
          chuli2 (atof (get_tile "eb"))
          chuli3 (atof (get_tile "ec"))
          chuli4 (atof (get_tile "ed"))
)


(if (not chuli1)(caozuo1));
(if (not chuli2)(caozuo2));
(if (not chuli3)(caozuo3));
(if (not chuli4)(caozuo4));




;  (action_tile "ea" "(caozuo1)")
  ;  (action_tile "eb" "(caozuo2)")
  ;  (action_tile "ec" "(caozuo3)")
  ;  (action_tile "ed" "(caozuo4)")




(princ)
)






(defun caozuo1()
(setq targetdir (getFolder "选择文件夹，以便保存绑定后的文件"))
  (setq scrfile (open "c:/bind.scr" "w"))
  (foreach dwgfile sfiles   
    (write-line (strcat "open \"" dwgfile "\"") scrfile)


     (write-line "_.purge all * n" scrfile)
     (write-line "zoom e" scrfile)
    (write-line "zoom e" scrfile)
    (write-line "saveas" scrfile)
    (write-line "2010" scrfile)
    (setq sfdir (strcat targetdir  "\\" (vl-filename-base  dwgfile)))
    (write-line  (strcat "\"" sfdir "\"" ) scrfile)
    (write-line  (strcat "(if (findfile \"" sfdir "\") (command \"yes\"))") scrfile)
    (write-line "close" scrfile)
  )
  (close scrfile)
  (command "script" "c:/bind.scr")  
)


(defun caozuo2()
(setq scrfile (open "c:/plql.scr" "w"))
  (foreach dwgfile sfiles   
    (write-line (strcat "open \"" dwgfile "\"") scrfile)


    (write-line "_.purge all * n" scrfile)
    (write-line "ggppa" scrfile)
    (write-line "zoom e" scrfile)
    (write-line "qsave" scrfile)
    (write-line "close" scrfile)
  )
  (close scrfile)
  (command "script" "c:/plql.scr")  
)


(defun caozuo3()
  (setq scrfile (open "c:/ggtt.scr" "w"))
  (foreach dwgfile sfiles   
    (write-line (strcat "open \"" dwgfile "\"") scrfile)


    (write-line "_.purge all * n" scrfile)
    (write-line "ggtt" scrfile)
    (write-line "zoom e" scrfile)
    (write-line "qsave" scrfile)
    (write-line "close" scrfile)
  )
  (close scrfile)
  (command "script" "c:/ggtt.scr")  
)




(defun caozuo4()
  (setq scrfile (open "c:/plsc.scr" "w"))
  (foreach dwgfile sfiles   
    (write-line (strcat "open \"" dwgfile "\"") scrfile)


    (write-line "_.purge all * n" scrfile)
    (write-line "cb11" scrfile)
    (write-line "zoom e" scrfile)
    (write-line "qsave" scrfile)
   (write-line "close" scrfile)
  )
  (close scrfile)
  (command "script" "c:/plsc.scr")  
)

dami

已经将该功能实现