使用DBX读外部图根据特点属性值更改DWG名字

marting

根据图中的属性块的属性内容，修改图的名字

自己修改下面的语句适合你的需要

    (setq BlkName "CIR-NOTE") ; update to your block name
    (setq TagName "NOTE") ; update to your attribute's tag value

1. (defun c:BatchRename (/ *error* Directory-Dia BlkName TagName Dir dbxApp FileName RenameList )
   
2.    
   
3.     (vl-load-com)
   
4.     (defun *error* (msg)
   
5.         
   
6.         (if dbxApp (vlax-release-object dbxApp))
   
7.         (setq dbxApp nil)
   
8.         (vl-bt)
   
9.     )
   
10.     ;---------------------------------------------------------
    
11.     (defun Directory-Dia ( Message / sh folder folderobject result)
    
12.     ;; By Tony Tanzillo
    
13.     ;; Modified by Tim Willey
    
14.     ;; 16 Will let you type in the path
    
15.     ;; 64 Will let you create a new folder
    
16. 
    
17.             (vl-load-com)
    
18.             (setq sh
    
19.                     (vla-getInterfaceObject
    
20.                             (vlax-get-acad-object)
    
21.                             "Shell.Application"
    
22.                     )
    
23.             )
    
24. 
    
25. 
    
26.             (setq folder
    
27.                     (vlax-invoke-method
    
28.                             sh
    
29.                             'BrowseForFolder
    
30.                             (vla-get-HWND (vlax-get-Acad-Object))
    
31.                             Message
    
32.                             0 ; This is the bit number to change.
    
33.                     )
    
34.             )
    
35.             (vlax-release-object sh)
    
36. 
    
37. 
    
38.             (if folder
    
39.                     (progn
    
40.                             (setq folderobject
    
41.                                     (vlax-get-property folder 'Self)
    
42.                             )
    
43.                             (setq result
    
44.                                     (vlax-get-property FolderObject 'Path)
    
45.                             )
    
46.                             (vlax-release-object folder)
    
47.                             (vlax-release-object FolderObject)
    
48.                             (if (/= (substr result (strlen result)) "\\")
    
49.                                     (setq result (strcat result "\\"))
    
50.                                     result
    
51.                             )
    
52.                     )
    
53.             )
    
54.     )
    
55.     ;--------------------------------------------------------------------------------------
    
56.     (setq BlkName "CIR-NOTE") ; update to your block name
    
57.     (setq TagName "NOTE") ; update to your attribute's tag value
    
58.    
    
59.     (if (setq Dir (Directory-Dia "Select directory to rename."))
    
60.         (progn
    
61.             (setq dbxApp
    
62.                 (if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
    
63.                     (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
    
64.                     (vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))
    
65.                 )
    
66.             )
    
67.             (foreach file (mapcar (function (lambda (x) (strcat Dir x))) (vl-directory-files Dir "*.dwg" 1))
    
68.                 (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list dbxApp file)))
    
69.                     (prompt (strcat "\n *Error opening file: " file))
    
70.                     (vlax-for lo (vla-get-Layouts dbxApp)
    
71.                         (vlax-for obj (vla-get-Block lo)
    
72.                             (if
    
73.                                 (and
    
74.                                     (= (vla-get-ObjectName obj) "AcDbBlockReference")
    
75.                                     (= (vla-get-Name obj) BlkName)
    
76.                                 )
    
77.                                 (foreach att (vlax-invoke obj 'GetAttributes)
    
78.                                     (if (= (vla-get-TagString att) TagName)
    
79.                                         (setq FileName (vla-get-TextString att))
    
80.                                     )
    
81.                                 )
    
82.                             )
    
83.                         )
    
84.                     )
    
85.                 )
    
86.                 (setq RenameList (cons (cons file FileName) RenameList))
    
87.                 (setq FileName nil)
    
88.             )
    
89.         )
    
90.     )
    
91.     (vlax-release-object dbxApp)
    
92.     (setq dbxApp nil)
    
93.     (foreach i RenameList
    
94.         (if
    
95.             (or
    
96.                 (null (cdr i))
    
97.                 (not (vl-file-rename (car i) (strcat Dir (cdr i) ".dwg")))
    
98.             )
    
99.             (prompt "\n *Was not able to rename: " (car i))
    
100.         )
     
101.     )
     
102.     (princ)
     
103. )
     

(defun c:BatchRename (/ *error* Directory-Dia BlkName TagName Dir dbxApp FileName RenameList )<br />     <br />     (vl-load-com)<br />     (defun *error* (msg)<br />         <br />         (if dbxApp (vlax-release-object dbxApp))<br />         (setq dbxApp nil)<br />         (vl-bt)<br />     )<br />     ;---------------------------------------------------------<br />     (defun Directory-Dia ( Message / sh folder folderobject result)<br />     ;; By Tony Tanzillo<br />     ;; Modified by Tim Willey<br />     ;; 16 Will let you type in the path<br />     ;; 64 Will let you create a new folder<br /> <br />             (vl-load-com)<br />             (setq sh<br />                     (vla-getInterfaceObject<br />                             (vlax-get-acad-object)<br />                             "Shell.Application"<br />                     )<br />             )<br /> <br /> <br />             (setq folder<br />                     (vlax-invoke-method<br />                             sh<br />                             'BrowseForFolder<br />                             (vla-get-HWND (vlax-get-Acad-Object))<br />                             Message<br />                             0 ; This is the bit number to change.<br />                     )<br />             )<br />             (vlax-release-object sh)<br /> <br /> <br />             (if folder<br />                     (progn<br />                             (setq folderobject<br />                                     (vlax-get-property folder 'Self)<br />                             )<br />                             (setq result<br />                                     (vlax-get-property FolderObject 'Path)<br />                             )<br />                             (vlax-release-object folder)<br />                             (vlax-release-object FolderObject)<br />                             (if (/= (substr result (strlen result)) "\\")<br />                                     (setq result (strcat result "\\"))<br />                                     result<br />                             )<br />                     )<br />             )<br />     )<br />     ;--------------------------------------------------------------------------------------<br />     (setq BlkName "CIR-NOTE") ; update to your block name<br />     (setq TagName "NOTE") ; update to your attribute's tag value<br />     <br />     (if (setq Dir (Directory-Dia "Select directory to rename."))<br />         (progn<br />             (setq dbxApp<br />                 (if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)<br />                     (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")<br />                     (vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))<br />                 )<br />             )<br />             (foreach file (mapcar (function (lambda (x) (strcat Dir x))) (vl-directory-files Dir "*.dwg" 1))<br />                 (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list dbxApp file)))<br />                     (prompt (strcat "\n *Error opening file: " file))<br />                     (vlax-for lo (vla-get-Layouts dbxApp)<br />                         (vlax-for obj (vla-get-Block lo)<br />                             (if<br />                                 (and<br />                                     (= (vla-get-ObjectName obj) "AcDbBlockReference")<br />                                     (= (vla-get-Name obj) BlkName)<br />                                 )<br />                                 (foreach att (vlax-invoke obj 'GetAttributes)<br />                                     (if (= (vla-get-TagString att) TagName)<br />                                         (setq FileName (vla-get-TextString att))<br />                                     )<br />                                 )<br />                             )<br />                         )<br />                     )<br />                 )<br />                 (setq RenameList (cons (cons file FileName) RenameList))<br />                 (setq FileName nil)<br />             )<br />         )<br />     )<br />     (vlax-release-object dbxApp)<br />     (setq dbxApp nil)<br />     (foreach i RenameList<br />         (if<br />             (or<br />                 (null (cdr i))<br />                 (not (vl-file-rename (car i) (strcat Dir (cdr i) ".dwg")))<br />             )<br />             (prompt "\n *Was not able to rename: " (car i))<br />         )<br />     )<br />     (princ)<br /> )<br />