Очистка следов 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

Отработало "на ура" :)

Размещено в AutoCAD, Код LISP, Прочее ПО · Метки: , ,



Поделитесь своим мнением


Я не робот.