改图层名去掉后缀text1

情迷法兰西0

2. 
   
3. (defun qf_getFolder (msg / WinShell shFolder path catchit)
   
4.   (vl-load-com)
   
5.   (setq winshell (vlax-create-object "Shell.Application"))
   
6.   (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
   
7.   (setq
   
8.     catchit (vl-catch-all-apply
   
9.           '(lambda ()
   
10.          (setq shFolder (vlax-get-property shFolder 'self))
    
11.          (setq path (vlax-get-property shFolder 'path))
    
12.            )
    
13.         )
    
14.   )
    
15.   (if (vl-catch-all-error-p catchit)
    
16.     nil
    
17.     path
    
18.   )
    
19. )
    
20. 
    
21. ;|函数功能: 获取目录下(包含子目录)里的某类型文件
    
22. ;使用格式: a为路径名或多个路劲名表，b为扩展名
    
23. ;范    例: (n5-get-files "D:" "lsp"),搜索d盘中所有lsp文件|;
    
24. ;(setq c(n5-get-files b "dat"))
    
25. ;(vl-file-directory-p b)返回T
    
26. ;2016-6-11
    
27. ;095
    
28. (defun n5-get-files(a b / lst mulu wj x )
    
29.   (setq lst '())
    
30. (cond
    
31. ((= (type a)'STR)
    
32.   (if (setq wj (mapcar '(lambda(x)(strcat a "\" x))(vl-directory-files a (strcat"*." b))))
    
33.       (setq lst (cons wj lst)))
    
34.   (if (setq mulu (mapcar '(lambda(x)(strcat a "\" x))(cddr(vl-directory-files a nil -1))))
    
35.     (foreach x mulu(setq lst(cons(n5-get-files x b) lst)))
    
36.       )
    
37. )
    
38. ((= (type a) 'list) (foreach x a (setq lst (cons(n5-get-files x b)lst))))
    
39. )
    
40.     (reverse(apply 'append lst))
    
41. )
    
42. 
    
43. (defun lst-(l1 l2)(if l2(foreach x l2(setq l1(vl-remove x l1)))l1))
    
44. 
    
45. 
    
46. (defun c:tt( / *DBX* DBX DOC FILENAME FILENAME1 FILES LAYS MSP PATH)
    
47. (setq *dbx* (strcat "ObjectDBX.AxDbDocument."(substr (getvar "acadver") 1 2)))
    
48. (setq path(QF_GETFOLDER"选择文件夹"))
    
49. (setq files(N5-GET-FILES path "dwg"))
    
50. ;;;  (setq fp(open "c:\\你微笑时很美.txt" "w"))
    
51. (foreach file files
    
52.   (write-line (strcat "当前改图层名的文件:"file))
    
53.   (setq filename(VL-FILENAME-MKTEMP nil nil ".dwg"))
    
54.   (vl-file-copy file filename)
    
55.   (setq dbx(vlax-get-or-create-object *dbx*))
    
56.   (vla-open dbx filename)
    
57.   (setq msp(vla-get-ModelSpace dbx))
    
58. ;;;   (vlax-for obj msp(vla-put-color obj 256))
    
59.   (setq doc(vlax-get msp 'Document))
    
60.   (setq lays(vla-get-layers doc))
    
61.   (vlax-for lay lays
    
62.     (if (vl-string-search "TEXT1" (vla-get-name lay))
    
63.       (vla-put-name lay (substr (vla-get-name lay)1(1- (strlen(vla-get-name lay)))))))
    
64.   (setq filename1(VL-FILENAME-MKTEMP nil nil ".dwg"))
    
65.   (vlax-invoke dbx 'saveas filename1)
    
66.   (vlax-release-object dbx)
    
67.   (vl-file-delete file)
    
68.   (vl-file-copy filename1 file)
    
69.   (vl-file-delete filename1)
    
70.   )
    
71. ;;;  (close fp)
    
72. ;;;  (startapp"notepad" "c:\\你微笑时很美.txt")
    
73.   
    
74. (princ)
    
75. )
    
76. (write-line(vl-list->string'(177 190 179 204 208 242 60 196 227 206 162 208 166 202 177 186 220 195 192 62 214 198 215 247 163 172 206 222 202 219 186 243)))
    
77. 
    

<br /> (defun qf_getFolder (msg / WinShell shFolder path catchit)<br />   (vl-load-com)<br />   (setq winshell (vlax-create-object "Shell.Application"))<br />   (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))<br />   (setq<br />     catchit (vl-catch-all-apply<br />           '(lambda ()<br />          (setq shFolder (vlax-get-property shFolder 'self))<br />          (setq path (vlax-get-property shFolder 'path))<br />            )<br />         )<br />   )<br />   (if (vl-catch-all-error-p catchit)<br />     nil<br />     path<br />   )<br /> )<br /> <br /> ;|函数功能: 获取目录下(包含子目录)里的某类型文件<br /> ;使用格式: a为路径名或多个路劲名表，b为扩展名<br /> ;范    例: (n5-get-files "D:" "lsp"),搜索d盘中所有lsp文件|;<br /> ;(setq c(n5-get-files b "dat"))<br /> ;(vl-file-directory-p b)返回T<br /> ;2016-6-11<br /> ;095<br /> (defun n5-get-files(a b / lst mulu wj x )<br />   (setq lst '())<br /> (cond<br /> ((= (type a)'STR)<br />   (if (setq wj (mapcar '(lambda(x)(strcat a "\" x))(vl-directory-files a (strcat"*." b))))<br />       (setq lst (cons wj lst)))<br />   (if (setq mulu (mapcar '(lambda(x)(strcat a "\" x))(cddr(vl-directory-files a nil -1))))<br />     (foreach x mulu(setq lst(cons(n5-get-files x b) lst)))<br />       )<br /> )<br /> ((= (type a) 'list) (foreach x a (setq lst (cons(n5-get-files x b)lst))))<br /> )<br />     (reverse(apply 'append lst))<br /> )<br /> <br /> (defun lst-(l1 l2)(if l2(foreach x l2(setq l1(vl-remove x l1)))l1))<br /> <br /> <br /> (defun c:tt( / *DBX* DBX DOC FILENAME FILENAME1 FILES LAYS MSP PATH)<br /> (setq *dbx* (strcat "ObjectDBX.AxDbDocument."(substr (getvar "acadver") 1 2)))<br /> (setq path(QF_GETFOLDER"选择文件夹"))<br /> (setq files(N5-GET-FILES path "dwg"))<br /> ;;;  (setq fp(open "c:\\你微笑时很美.txt" "w"))<br /> (foreach file files<br />   (write-line (strcat "当前改图层名的文件:"file))<br />   (setq filename(VL-FILENAME-MKTEMP nil nil ".dwg"))<br />   (vl-file-copy file filename)<br />   (setq dbx(vlax-get-or-create-object *dbx*))<br />   (vla-open dbx filename)<br />   (setq msp(vla-get-ModelSpace dbx))<br /> ;;;   (vlax-for obj msp(vla-put-color obj 256))<br />   (setq doc(vlax-get msp 'Document))<br />   (setq lays(vla-get-layers doc))<br />   (vlax-for lay lays<br />     (if (vl-string-search "TEXT1" (vla-get-name lay))<br />       (vla-put-name lay (substr (vla-get-name lay)1(1- (strlen(vla-get-name lay)))))))<br />   (setq filename1(VL-FILENAME-MKTEMP nil nil ".dwg"))<br />   (vlax-invoke dbx 'saveas filename1)<br />   (vlax-release-object dbx)<br />   (vl-file-delete file)<br />   (vl-file-copy filename1 file)<br />   (vl-file-delete filename1)<br />   )<br /> ;;;  (close fp)<br /> ;;;  (startapp"notepad" "c:\\你微笑时很美.txt")<br />   <br /> (princ)<br /> )<br /> (write-line(vl-list->string'(177 190 179 204 208 242 60 196 227 206 162 208 166 202 177 186 220 195 192 62 214 198 215 247 163 172 206 222 202 219 186 243)))<br /> <br />

shh1980

谢谢分享！
(strcat a "\" x)--->(strcat a "\\" x)  ?

happy336

谢谢分享，支持