使用DBX批量修改外部DWG图形的打印样式表

marting · 发表于 2018-11-16 14:07:55

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

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

×

(defun c:changepc3 (/ _openfile _subfolders _getdirectory dir doc
folders l logfile new odbx old save v
)
(vl-load-com)
;; Change this value - ie. { "*" or "\\\\servername\\oldsharedprintername" }
(setq old "*")
;; Change this value - ie. { "MyplotStyle.ctb" or "\\\\servername\\newsharedprintername" }
(setq new "MyplotStyle.ctb")
(defun _openfile (file / sh)
(if (findfile file)
(progn (setq sh (vlax-get-or-create-object "Shell.Application"))
(vlax-invoke-method sh 'open (findfile file))
(vlax-release-object sh)
file
)
)
)
(defun _getdirectory (message / sh folder result)
(setq sh (vlax-get-or-create-object "Shell.Application"))
(setq folder (vlax-invoke-method sh 'browseforfolder 0 message 0))
(vlax-release-object sh)
(if folder
(progn (setq
result (vlax-get-property (vlax-get-property folder 'self)
'path
)
)
(if (/= (substr result (strlen result)) "\\")
(setq result (strcat result "\\"))
result
)
)
)
)
(defun _subfolders (path / folder fs lst subs)
(setq fs (vlax-get-or-create-object "Scripting.FileSystemObject"))
(if (and (setq folder (vlax-invoke fs 'getfolder path))
(setq subs (vlax-get folder 'subfolders))
)
(mapcar (function
(lambda (x) (cons x (apply 'append (_subfolders x))))
)
(vlax-for sub subs
(setq lst (cons (strcat (vlax-get sub 'path) "\\") lst))
)
)
)
)
(setq doc (vlax-get-acad-object))
(cond
((not
(setq
odbx (if (< (setq v (substr (getvar 'acadver) 1 2)) "16")
(vla-getinterfaceobject doc "ObjectDBX.AxDbDocument")
(vla-getinterfaceobject
doc
(strcat "ObjectDBX.AxDbDocument." v)
)
)
)
)
(princ "\nObject DBX interface not created!")
)
((if (and (setq dir
(_getdirectory
"Choose a folder to process (subfolders processed too)..."
)
)
(and (setq folders (apply 'append (_subfolders dir)))
(setq folders (append (list dir) folders))
)
(setq logfile (open (setq l (strcat dir "logfile.csv")) "w"))
)
(progn
(write-line "FILE,TABS UPDATED,SAVED" logfile)
(foreach folder folders
(foreach file (vl-directory-files folder "*.dwg" 0)
(if (vl-catch-all-error-p
(vl-catch-all-apply 'vla-open
(list odbx (strcat folder file))
)
)
(write-line
(strcase
(strcat "!!Error opening: " (strcat folder file))
)
logfile
)
(progn
(setq save 0)
(vlax-for x (vla-get-layouts odbx)
(if (wcmatch (strcase (vla-get-configname x))
(strcase old)
)
(progn
(and
(not (vl-catch-all-error-p
(vl-catch-all-apply 'vla-put-configname
(list x new)
)
)
)
(setq save (1+ save))
)
)
)
)
(if (zerop save)
(write-line
(strcat (strcat folder file "," (itoa save) ",NO"))
logfile
)
(progn (write-line
(strcat
(strcat folder file "," (itoa save) ",YES")
)
logfile
)
(vla-saveas odbx (vla-get-name odbx))
)
)
)
)
)
)
(close logfile)
(_openfile l)
)
)
)
)
(princ)
)

(defun c:changepc3 (/ _openfile _subfolders _getdirectory dir doc 
                    folders l logfile new odbx old save v 
                   ) 
  (vl-load-com) 
  ;; Change this value - ie. { "*" or "\\\\servername\\oldsharedprintername" } 
  (setq old "*") 
  ;; Change this value - ie. { "MyplotStyle.ctb" or "\\\\servername\\newsharedprintername" } 
  (setq new "MyplotStyle.ctb") 
  (defun _openfile (file / sh) 
    (if (findfile file) 
      (progn (setq sh (vlax-get-or-create-object "Shell.Application")) 
             (vlax-invoke-method sh 'open (findfile file)) 
             (vlax-release-object sh) 
             file 
      ) 
    ) 
  ) 
  (defun _getdirectory (message / sh folder result) 
    (setq sh (vlax-get-or-create-object "Shell.Application")) 
    (setq folder (vlax-invoke-method sh 'browseforfolder 0 message 0)) 
    (vlax-release-object sh) 
    (if folder 
      (progn (setq 
               result (vlax-get-property (vlax-get-property folder 'self) 
                                         'path 
                      ) 
             ) 
             (if (/= (substr result (strlen result)) "\\") 
               (setq result (strcat result "\\")) 
               result 
             ) 
      ) 
    ) 
  ) 
  (defun _subfolders (path / folder fs lst subs) 
    (setq fs (vlax-get-or-create-object "Scripting.FileSystemObject")) 
    (if (and (setq folder (vlax-invoke fs 'getfolder path)) 
             (setq subs (vlax-get folder 'subfolders)) 
        ) 
      (mapcar (function 
                (lambda (x) (cons x (apply 'append (_subfolders x)))) 
              ) 
              (vlax-for sub subs 
                (setq lst (cons (strcat (vlax-get sub 'path) "\\") lst)) 
              ) 
      ) 
    ) 
  ) 
  (setq doc (vlax-get-acad-object)) 
  (cond 
    ((not 
       (setq 
         odbx (if (< (setq v (substr (getvar 'acadver) 1 2)) "16") 
                (vla-getinterfaceobject doc "ObjectDBX.AxDbDocument") 
                (vla-getinterfaceobject 
                  doc 
                  (strcat "ObjectDBX.AxDbDocument." v) 
                ) 
              ) 
       ) 
     ) 
     (princ "\nObject DBX interface not created!") 
    ) 
    ((if (and (setq dir 
                     (_getdirectory 
                       "Choose a folder to process (subfolders processed too)..." 
                     ) 
              ) 
              (and (setq folders (apply 'append (_subfolders dir))) 
                   (setq folders (append (list dir) folders)) 
              ) 
              (setq logfile (open (setq l (strcat dir "logfile.csv")) "w")) 
         ) 
       (progn 
         (write-line "FILE,TABS UPDATED,SAVED" logfile) 
         (foreach folder folders 
           (foreach file (vl-directory-files folder "*.dwg" 0) 
             (if (vl-catch-all-error-p 
                   (vl-catch-all-apply 'vla-open 
                                       (list odbx (strcat folder file)) 
                   ) 
                 ) 
               (write-line 
                 (strcase 
                   (strcat "!!Error opening: " (strcat folder file)) 
                 ) 
                 logfile 
               ) 
               (progn 
                 (setq save 0) 
                 (vlax-for x (vla-get-layouts odbx) 
                   (if (wcmatch (strcase (vla-get-configname x)) 
                                (strcase old) 
                       ) 
                     (progn 
                       (and 
                         (not (vl-catch-all-error-p 
                                (vl-catch-all-apply 'vla-put-configname 
                                                    (list x new) 
                                ) 
                              ) 
                         ) 
                         (setq save (1+ save)) 
                       ) 
                     ) 
                   ) 
                 ) 
                 (if (zerop save) 
                   (write-line 
                     (strcat (strcat folder file "," (itoa save) ",NO")) 
                     logfile 
                   ) 
                   (progn (write-line 
                            (strcat 
                              (strcat folder file "," (itoa save) ",YES") 
                            ) 
                            logfile 
                          ) 
                          (vla-saveas odbx (vla-get-name odbx)) 
                   ) 
                 ) 
               ) 
             ) 
           ) 
         ) 
         (close logfile) 
         (_openfile l) 
       ) 
     ) 
    ) 
  ) 
  (princ) 
)

taoyi0727 · 发表于 2019-6-27 19:15:19

研究了一下午才把这个代码看懂了个大概
有个小问题
后台打开的CAD没有关闭

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

[每日一码] 使用DBX批量修改外部DWG图形的打印样式表

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