Очистка следов VBA в файле dwg
Не далее как сегодня пришло несколько файлов dwg, при открытии которых AutoCAD 2009 начинал спрашивать - подключать или нет макросы.
Естественно, что ответ "Нет". Но не будешь же каждый раз такое нажимать!
В результате родился такой вот код (знаю, что где-то было подобное решение; но искать было лень):
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 | (defun purge-vba (/ dict err err_lst) (if (not (vl-catch-all-error-p (setq dict (vl-catch-all-apply (function (lambda () (vla-item (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object)) ) ;_ end of vla-get-Dictionaries "ACAD_VBA" ) ;_ end of vla-item ) ;_ end of lambda ) ;_ end of function ) ;_ end of vl-catch-all-apply ) ;_ end of setq ) ;_ end of vl-catch-all-error-p ) ;_ end of not (vlax-for item dict (if (vl-catch-all-error-p (setq err (vl-catch-all-apply (function (lambda () (vla-delete item) ) ;_ end of lambda ) ;_ end of function ) ;_ end of vl-catch-all-apply ) ;_ end of setq ) ;_ end of vl-catch-all-error-p (setq err_lst (cons (cons (vla-get-name item) (vl-catch-all-error-message err) ) ;_ end of cons ) ;_ end of cons ) ;_ end of setq ) ;_ end of if ) ;_ end of vlax-for ) ;_ end of if (if err_lst (princ (strcat "Errors:" (apply (function strcat) (mapcar (function (lambda (x) (strcat "\n" (car x) " : " (cdr x)) ) ;_ end of lambda ) ;_ end of function err_lst ) ;_ end of mapcar ) ;_ end of apply ) ;_ end of strcat ) ;_ end of princ ) ;_ end of if ) ;_ end of defun |
Отработало "на ура" 
