树櫴希德 发表于 2016-9-14 16:05:21

收藏73哥函数 程序---列出文件夹下所有子文件荚或者文件名

收藏73哥函数 程序---列出文件夹下所有子文件荚或者文件名

命令: (vl-directory-files (GetFolder"\n批量修改子文件夹名称") "*.*" -1) ("."
".." "A" "E" "ES匝道" "F匝道" "sc" "一点点" "万博一1路" "万博一路"
"万博一路坡脚" "京台高速" "港B五标" "湘潭" "积木法" "穗丰年路" "西宁绕城"
"进港南路")

命令: 'VLIDE
命令:
命令: (vl-directory-files (GetFolder"\n批量修改子文件夹名称") "*.*" 1)
("其他参数.txt" "项目名称.txt")

命令: 'VLIDE
命令:
命令: (vl-directory-files (GetFolder"\n批量修改子文件夹名称") "*.*" 0) ("."
".." "A" "E" "ES匝道" "F匝道" "sc" "一点点" "万博一1路" "万博一路"
"万博一路坡脚" "京台高速" "其他参数.txt" "港B五标" "湘潭" "积木法" "穗丰年路"
"西宁绕城" "进港南路" "项目名称.txt")
语法   (vl-directory-files)
功能
列出给定目录中的所有文件。
说明     1)参数 directory 为字符串,指定要收集文件的目录。若未指定该参数或参数为 nil,那么vl-directory-files 使用当前目录。    2)参数 pattern 为字符串,包含文件名的 DOS 方式。如果未指定该参数或参数为 nil,vl-directory-files 假定为 "*.*"。    3)directories 为整数型,指定返回的表中是否包含路径名。可以指定下列值之一:-1仅列出目录。0   列出文件和目录(缺省值)。1   仅列出文件。 返回值: 文件和路径列表。若没有符合指定方式的文件,则返回 nil。(defun t1(patha a1 b1)
(if(vl-file-directory-p patha)
    (foreach x(vl-directory-files patha(strcat"*"a1"*")-1)
      (if(vl-string-search a1 x)
      (vl-file-rename(strcat patha"\\"x)(strcat patha"\\"(vl-string-subst b1 a1 x)))))))
(defun GetFolder(msg / WinShell shFolder path)
    (setq winshell (vlax-create-object "Shell.Application")
          shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
    (if (vl-catch-all-error-p(vl-catch-all-apply'(lambda ()(setq shFolder(vlax-get-property shFolder'self))
                                                   (setq path (vlax-get-property shFolder 'path)))))nil path))

(defun c:t1(/ patha a b)
(vl-load-com)
(if(and(setq patha(GetFolder"\n批量修改子文件夹名称"))
         (setq a(getstring"要被替换的字符")b(getstring"替换为")))
    (t1 patha a b)))


;文件夹名称都可以批量改,文件名当然也可以
;仔细看下vl-directory-files的用法。。。。你就可以参照t1自己写一个改文件名的了

树櫴希德 发表于 2022-11-6 20:59:25

(defun GetFolder(msg / WinShell shFolder path catchit);选取文件夹
      (setq shFolder(vlax-invoke-method (vlax-create-object "Shell.Application")'BrowseForFolder 0 msg 1))
      (setqcatchit(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 xdirectory(folder)
      (setq folder(list(list folder)))
      (while(car(setq folder(cons(apply'append(mapcar'(lambda(x)(mapcar'(lambda(y)(strcat x"\\"y))(cddr(vl-directory-files X nil -1))))
               (car folder)))folder))))(apply'append folder))
(defun getpath(msg ext / path paths files)
(and(setq path(GETFOLDER msg))
      (setq paths(XDIRECTORY path))
      (setq files(apply'append(mapcar'(lambda(x)(mapcar'(lambda(y)(strcat x "\\"y))(VL-DIRECTORY-FILES x ext 1)))paths)))
      )(list paths files))
(defun StrType(a / b c d e);;字符串分离全角、符号、字母、数字,存在问题:连续小数点与数字相连不能精确分离数字和小数点
    (setq b(vl-string->list a))
    (while b
      (setq a(car b)b(cdr b)c(last d))
      (if(or(not d)
      (and(< 0 a 32)(< 0 c 32));;非打印字符
      (or(= 46 a)(= 46 c)(and(< 47 a 58)(< 47 c 58)));数字和小数点
      (vl-every'(lambda(x)(vl-some'(lambda(y)(<(car y)x(cadr y)))'((31 48)(57 65)(90 98)(122 129))))(list a c));其它字符包括小数点
      (vl-every'(lambda(x)(vl-some'(lambda(y)(<(car y)x(cadr y)))'((64 91)(96 123))))(list a c));;字母
      (and(> a 128)(> c 128)));;全角字符
(if(> a 128)(setq d(vl-list*(car b)a d)b(cdr b))(setq d(cons a d)))
(setq e(cons(reverse d)e)d(if(> a 128)(list(car b)a)(List a))b(if(> a 128)(cdr b)b))))
    (mapcar'vl-list->string(reverse(cons(reverse d)e))))

(defun c:tt(/ wdapp docs fs)
(and(setq wdapp(vlax-create-object"word.application"))
      (setq docs(vlax-get-property wdapp 'documents)
      files(cadr(getpath"选择文件夹,批量修改WORD文件名""*.doc*")))
      (vl-every(function(lambda(x / doc i a b)
      (setq doc(vlax-invoke-method docs'open x)Paragraphs(vlax-get-property doc'Paragraphs)i 0)
      (while(not a)
      (or(WCMATCH(setq i(1+ 0)a(vlax-get-property(vlax-get-property(vlax-invoke-method Paragraphs'item i)'range)'TEXT))"*\r")
         (setq a nil)))
      (vlax-invoke-method doc'close)
      (if a(progn(setq a(substr a 1(1-(strlen a))))
         (while(vl-position a fs)
       (setq a(if(numberp(setq as(StrType a)b(read(last as))))
          (apply'strcat(append(reverse(cdr(reverse as)))(list(itoa(1+ b)))))
          (strcat a"1"))))
         (setq fs(cons a fs))
         (vl-file-rename x(strcat(VL-FILENAME-DIRECTORY x)"\\"a(VL-FILENAME-EXTENSION x)))))t))files)
      (vlax-invoke-method wdapp'quit)))

树櫴希德 发表于 2022-9-19 19:42:52


表内汉语根据声母首字母排序
;■■■(275988734) 2022/9/19 17:52:06
(defun sortn(l keys funs fuzz / n mposition);;;keys关键字列号要么为nil要么为表,funs各个关键字的排序方式,通常为<或>,也可以为自定义序列,比如'("张三""李四")
(defun mposition(e l / i)(if(setq i(vl-position e l))i(length l)))
(or(listp(car l))(setq l(mapcar'list l)))
(or(listp funs)(setq funs(list funs)))
(if(zerop(setq n(length keys)))(setq n(length(car l))))
(while(<(length funs)n)(setq funs(cons(car funs)funs)))
(mapcar(function(lambda(x)(nth x l)))
   (vl-sort-i(if keys(mapcar(function(lambda(x)(mapcar'(lambda(y)(nth y x))keys)))l)l)
       (function(lambda(x y / n )(setq n 0)
          (while(and(equal(car x)(car y)fuzz)(cdr x)(cdr y))(setq x(cdr x)y(cdr y)n(1+ n)))
            (if(listp(setq n(nth n funs)))
      (<(mposition(car x)n)(mposition(car y)n))
      (n(car x)(car y))))))))

;■■■(275988734) 2022/9/19 17:52:18
;_$ (SORTN'(("上海""崇明区")("北京""朝阳区")("上海""静安区")("北京""房山区")("重庆""酉阳")("四川""成都"))'(0 1)'(("北京""上海")("静安区""朝阳区""房山区""崇明区""成都""酉阳"))0)
(("北京" "朝阳区") ("北京" "房山区") ("上海" "静安区") ("上海" "崇明区") ("四川" "成都") ("重庆" "酉阳"))




树櫴希德 发表于 2020-2-22 22:37:29

(defun GetFolder(msg / WinShell shFolder path)
    (setq winshell (vlax-create-object "Shell.Application")
          shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
    (if (vl-catch-all-error-p(vl-catch-all-apply'(lambda ()(setq shFolder(vlax-get-property shFolder'self))
                                                   (setq path (vlax-get-property shFolder 'path)))))nil path))
(defun tpzx ( patha / i xx xxx)
    (setq i 1)(vl-load-com)
(if(vl-file-directory-p patha)
    (foreach x(vl-directory-files patha "*" 1)
      (setq xx (strcat (rtos i 2 0 ) x)) (setq xxx (strcat patha "\\" xx) )

      (vl-file-rename (strcat patha"\\"x) xxx )(setq i (1+ i))   )))


      (defun c:tt1 ( / patha)
    (vl-load-com)

(if(setq patha(GetFolder"\n批量修改子文件夹名称"))
         
    (tpzx patha ))
   
    )

    ;(vl-directory-files (GetFolder"\n批量修改子文件夹名称") "*" 1)

taotao001 发表于 2016-9-16 10:50:14

学习一下

mattran 发表于 2016-9-26 16:12:17

厉害~~~~~~~~~~~~~~~~~~~

树櫴希德 发表于 2020-2-18 18:53:18

(defun GetFolder(msg / WinShell shFolder path)
    (setq winshell (vlax-create-object "Shell.Application")
          shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
    (if (vl-catch-all-error-p(vl-catch-all-apply'(lambda ()(setq shFolder(vlax-get-property shFolder'self))
                                                   (setq path (vlax-get-property shFolder 'path)))))nil path))

(vl-directory-files(GetFolder"\n批量修改子文件夹名称") "*"1)

树櫴希德 发表于 2020-2-23 10:48:49


批量文件名后面递增加数字T1.LSP
(defun t1(patha a1/ i)
(setq i 1)
(if(vl-file-directory-p patha)
    (foreach x(vl-directory-files patha "*" 1)
      (if(vl-string-search a1 x)
      (vl-file-rename(strcat patha"\\"x)(strcat patha"\\"(vl-string-subst(strcat (rtos i 2 0) a1)a1x))))
      (setq i (1+ i)) )
    ))
(defun GetFolder(msg / WinShell shFolder path)
    (setq winshell (vlax-create-object "Shell.Application")
          shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
    (if (vl-catch-all-error-p(vl-catch-all-apply'(lambda ()(setq shFolder(vlax-get-property shFolder'self))
                                                   (setq path (vlax-get-property shFolder 'path)))))nil path))

(defun c:t1( / patha)
(vl-load-com)
(if(setq patha(GetFolder"\n批量修改子文件夹名称"))
         
    (t1 patha ".")))

树櫴希德 发表于 2020-4-16 20:25:31

(defun XD::Internet:Ping (address / out ws)
(and (setq ws (vlax-get-or-create-object "WScript.Shell"))
       (setq out (vlax-invoke
                   ws
                   'run
                   (strcat "ping.exe -w 80 -n 1" address) ;;ping.exe -w 80 -n 1ping.exe -n 1
                   0
                   :vlax-true
               )
       )
       (vlax-release-object ws)
       (zerop out)
)
)

(setq a(XD::Internet:Ping "baidu.com"))
(princ(if a "网络通畅" "无网络"))
判断是否断网

f4800 发表于 2020-10-30 23:10:18

收藏73哥函数 程序---列出文件夹下所有子文件荚或者文件名

走走逛逛瞧瞧 发表于 2020-11-11 16:52:49

xj6019 发表于 2020-11-11 18:20:27

虽然感觉不大用的到,特别感谢楼主的源码,谢谢,已收藏
页: [1] 2 3
查看完整版本: 收藏73哥函数 程序---列出文件夹下所有子文件荚或者文件名