Палитры инструментов через лисп + xml

Автор: | Дата: 22 Май 2013 · 3 коммент. 

В прошлой записи я показал, как можно из-под лиспа добраться до xml-файла и поработать с ним. Пришло время иллюстрации номер раз :)

Задача: получить GUID палитр, их имен и путей соответствующих файлов, пройдя по всем каталогам, указанным в качестве ToolPalettesPath.

Опять же, переименовывать функции не хочу :) Все недостающие функции есть в архиве.

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
(defun _kpblc-get-toolpalettes-info-by-atc (atc-path / atc_file path res xml_doc xml_main)
                                           ;|
*    Возвращает полный перечень id палитр, их имен и путей на основе файла AcTpCatalog.atc
*    Параметры вызова:
  atc-path   каталог, в котором хранится файл AcTpCatalog.atc
*    Примеры вызова:
(_kpblc-get-toolpalettes-info-by-atc nil) ;; берет из всех каталогов с описаниями палитр.
|;
  (if (not atc-path)
    (foreach _path (_kpblc-conv-string-to-list
                     (vla-get-toolpalettepath (vla-get-files (vla-get-preferences (vlax-get-acad-object))))
                     ";"
                     ) ;_ end of _kpblc-conv-string-to-list
      (setq res (append res (_kpblc-get-toolpalettes-info-by-atc _path)))
      ) ;_ end of foreach
    (if (setq atc_file (findfile (strcat (_kpblc-dir-path-no-splash
                                           (if (vl-file-directory-p atc-path)
                                             atc-path
                                             (vl-filename-directory atc-path)
                                             ) ;_ end of if
                                           ) ;_ end of _kpblc-dir-path-no-splash
                                         "\\AcTpCatalog.atc"
                                         ) ;_ end of strcat
                                 ) ;_ end of findfile
              ) ;_ end of setq
      (progn
        (_kpblc-error-catch
          (function
            (lambda ()
              (setq xml_doc  (_kpblc-xml-doc-get atc_file)
                    xml_main (_kpblc-xml-node-get-main xml_doc)
                    res      (mapcar
                               (function
                                 (lambda (palette / tmp name)
                                   (setq
                                     tmp (vl-remove
                                           nil
                                           (apply
                                             'append
                                             (mapcar
                                               (function
                                                 (lambda (node)

                                                   (mapcar
                                                     (function
                                                       (lambda (item / _p)
                                                         (cond
                                                           ((and (= (car item) "href")
                                                                 (findfile (cdr item))
                                                                 ) ;_ end of and
                                                            item
                                                            )
                                                           ((and
                                                              (= (car item) "href")
                                                              (findfile
                                                                (setq
                                                                  _p (strcat
                                                                       (_kpblc-dir-path-and-splash
                                                                         (vl-filename-directory atc_file)
                                                                         ) ;_ end of _kpblc-dir-path-and-splash
                                                                       (vl-string-left-trim "\" (cdr item))
                                                                       ) ;_ end of strcat
                                                                  ) ;_ end of setq
                                                                ) ;_ end of findfile
                                                              ) ;_ end of and
                                                            (cons (car item) _p)
                                                            )
                                                           (t item)
                                                           ) ;_ end of cond
                                                         ) ;_ end of lambda
                                                       ) ;_ end of function
                                                     (_kpblc-xml-attribute-get-name-and-value node)
                                                     ) ;_ end of mapcar
                                                   ) ;_ end of lambda
                                                 ) ;_ end of function
                                               (_kpblc-xml-nodes-get-child palette)
                                               ) ;_ end of mapcar
                                             ) ;_ end of apply
                                           ) ;_ end of vl-remove
                                     ) ;_ end of setq
                                   (if
                                     (and (setq name (vl-filename-base (_kpblc-conv-value-to-string (cdr (assoc "href" tmp)))))
                                          (/= name "")
                                          ) ;_ end of and
                                      (setq tmp (_kpblc-list-add-or-subst tmp "name" (car (_kpblc-conv-string-to-list name "_"))))
                                      ) ;_ end of if
                                   tmp
                                   ) ;_ end of lambda
                                 ) ;_ end of function
                               (_kpblc-xml-nodes-get-child (car (_kpblc-xml-nodes-get-child-by-tag xml_main "Palettes")))
                               ) ;_ end of mapcar
                    ) ;_ end of setq
              ) ;_ end of lambda
            ) ;_ end of function
          nil
          ) ;_ end of _kpblc-error-catch
        (foreach item (list xml_main xml_doc)
          (if (not (vlax-object-released-p item))
            (vlax-release-object item)
            ) ;_ end of if
          ) ;_ end of foreach
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of if
  res
  ) ;_ end of defun

В результате выполнения (_kpblc-get-toolpalettes-info-by-atc nil) мы получим список вида

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
'((("name" . "Architectural")
   ("idvalue" . "{498DE575-CB69-4B2A-A12B-33012D265464}")
   ("href"
    .
    "C:\\Support\\ToolPalette\\Palettes\\Architectural_498DE575-CB69-4B2A-A12B-33012D265464.atc"
    )
   )
  (("name" . "Mechanical")
   ("idvalue" . "{5B6AC051-A4D1-4191-A86C-DFD866841B64}")
   ("href"
    .
    "C:\\Support\\ToolPalette\\Palettes\\Mechanical_5B6AC051-A4D1-4191-A86C-DFD866841B64.atc"
    )
   )
  (("name" . "Оборудование")
   ("idvalue" . "{5B6AC051-A4D1-4191-A86C-DFD866841B64}")
   ("href"
    .
    "\\\\server\\SupportPalettes\\Оборудование_5B6AC051-A4D1-4191-A86C-DFD866841B64.atc"
    )
   )
  (("name" . "Кабель")
   ("idvalue" . "{AAAC72E7-128D-4B0C-9A10-6C3EC55741B5}")
   ("href"
    .
    "\\\\server\\SupportPalettes\\Кабель_AAAC72E7-128D-4B0C-9A10-6C3EC55741B5.atc"
    )
   )
  )

Размещено в Код LISP, Новости, Функции LISP · Метки: , ,



Комментарии

Есть 3 коммент. к “Палитры инструментов через лисп + xml”
  1. Михаил пишет:
    8 Декабрь 2014 в 14:45

    Если загрузить lispru-xml-collection.lsp а потом приведенный листинг, то выходит ошибка
    ; ошибка: no function definition: _KPBLC-DIR-PATH-NO-SPLASH
    нельзя ли еще и функции _KPBLC-DIR-PATH... в архив добавить
    А то именно _KPBLC-DIR-PATH-NO-SPLASH в исходниках не увидел...
    Заранее благодарен

  2. Михаил пишет:
    11 Декабрь 2014 в 11:52

    Приведенная у тебя функция почему-то у меня не пошла...
    Поскольку мне нужны только ID палитр, применил такую конструкцию:

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    (setq list_atr (mapcar
                             (function _kpblc-xml-attribute-get-name-and-value
                             )
                            (mapcar
                               (function _kpblc-xml-nodes-get-child)
                               (_kpblc-xml-nodes-get-child
                                 (car (_kpblc-xml-nodes-get-child-by-tag
                                        xml_main
                                        "Palettes"
                                        ) ;_ end of _kpblc-xml-nodes-get-child-by-tag
                                 )
                               ) ;_ end of _kpblc-xml-nodes-get-child
                             ) ;_ end of mapcar
                           ) ;_ end of mapcar
    );end of setq

    Но есть одна странность. Нужные мне данные оказываются во вложенном (двойном) списке:
    ((((idvalue . {CE1AF905-1E75-49BC-A71A-50A2832C9ED8})) ((href . Palettes\4-1_Оформление_CE1AF905-1E75-49BC-A71A-50A2832C9ED8.atc)) nil nil) ...)
    В чем тут дело-не подскажешь?
    Не очень удобно обрабатывать. Да и есть сомнения - будет ли структура всегда такой.

  3. Кулик Алексей aka kpblc пишет:
    11 Декабрь 2014 в 17:16

    Попробуй применить append - по типу (apply 'append (mapcar (function _kpblc-xml-attribute...

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


Я не робот.