[Makswell]

Всем привет.

Дело в том, что стандартные:

Код:

[Выделить все]

(vl-cmdf "_.PURGE" "_a" "*" "_n")

и

Код:

[Выделить все]

(vla-purgeall (vla-get-ActiveDocument (vlax-get-acad-object)))

стили мультивыносок не трогают.

В стандартном диалоговом окне _.PURGE всё удаляется. Но в командном режиме _.-PURGE стили мультивыносок удалить невозможно.
Короче, хотелось бы программно.

PS AutoCAD 2008 SP1

[Кулик Алексей aka kpblc]

Вариант лиспом:

Код:

[Выделить все]

(defun purge-mleader (names / adoc dict)
     ; names - список имен стилей, которые надо оставлять. Обязательно оставляется стиль
     ; Standard
  (cond
    ((not names) (purge-mleader "*"))
    ((listp names)
     (purge-mleader
       (apply 'strcat (cons (car names) (mapcar '(lambda (x) (strcat "," x)) (cdr names))))
       ) ;_ end of purge-mleader
     )
    (t
     (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
     (setq names (strcase names))
     (if (not (vl-catch-all-error-p
                (setq dict (vl-catch-all-apply
                             (function
                               (lambda ()
                                 (vla-item (vla-get-dictionaries adoc) "ACAD_MLEADERSTYLE")
                                 ) ;_ 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 rec dict
         (if (and (not (wcmatch (strcase (vla-get-name rec)) (strcase names)))
                  (/= (strcase (vla-get-name rec)) "STANDARD")
                  ) ;_ end of and
           (vla-delete rec)
           ) ;_ end of if
         ) ;_ end of vlax-for
       ) ;_ end of if
     (vla-endundomark adoc)
     )
    ) ;_ end of cond
  ) ;_ end of defun

[Makswell]

Алексей, я думал в этом же направлении. Получается направление было выбрано верное

Но мне не нравится, то, что список имен стилей, которые надо оставлять, нужно вводить вручную.

Как бы сформировать этот список (именно неиспользуемые стили) программно? Неужели придётся анализировать всю БД рисунка на предмет наличия мультивыносок с их стилями?

Т.е. вот есть _.PURGE - там они показываются. Вот, грубо говоря, их и надо удалить. А у тебя сносится всё подчистую, даже несмотря например на то, что многие стили в диалоговом окне _.MLEADERSTYLE удаляться отказываются (что в общем-то безусловно разумно, ибо они используются в рисунке).

Короче, не исключено то, что удаление всего подчистую только на основании самим же составленного списка и без дополнительного анализа, может являться в будущем источником глюков и прочих граблей.

Так что в итоге повторюсь: есть ли на твой взгляд какой-нибудь способ, кроме как шерстить всю БД рисунка, для формирования списка неиспользуемых стилей программно?

[Кулик Алексей aka kpblc]

Вариант 2, достаточно тупой:

Код:

[Выделить все]

(defun purge-mleader (/ adoc dict)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (not (vl-catch-all-error-p
             (setq dict (vl-catch-all-apply
                          (function
                            (lambda ()
                              (vla-item (vla-get-dictionaries adoc) "ACAD_MLEADERSTYLE")
                              ) ;_ 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 rec dict
      (if (or (/= (strcase (vla-get-name rec)) "STANDARD")
              (> (vla-get-count dict) 1)
              ) ;_ end of or
        (vl-catch-all-apply (function (lambda () (vla-delete rec))))
        ) ;_ end of if
      ) ;_ end of vlax-for
    ) ;_ end of if
  (vla-endundomark adoc)
  ) ;_ end of defun

[Makswell]

Сообщение от Кулик Алексей aka kpblc Вариант 2, достаточно тупой:

Аналогично. Только теперь вообще всё сносит кроме "STANDARD". В итоге могут оставаться мультивыноски совсем не имеющие стиля

Добавлено:
Исследование объектной модели этой "нестильной" мультивыноски показали такое:

_$ (vlax-dump-object (vlax-ename->vla-object (car (entsel)))) ; IAcadMLeader: Интерфейс мультивыносок AutoCAD ; Значения свойств: ; Application (RO) = #<VLA-OBJECT IAcadApplication 00d74d3c> ; ArrowheadBlock = "_None" ; ArrowheadSize = 4.0 ; ArrowheadType = 19 ; BlockConnectionType = 0 ; ContentBlockName = "" ; ContentBlockType = 6 ; ContentType = 2 ; Document (RO) = #<VLA-OBJECT IAcadDocument 204da138> ; DogLegged = 0 ; DoglegLength = 0.0 ; Handle (RO) = "262D" ; HasExtensionDictionary (RO) = 0 ; Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 1dcef2cc> ; LandingGap = 2.0 ; Layer = "0" ; LeaderCount (RO) = 1 ; LeaderLineColor = #<VLA-OBJECT IAcadAcCmColor 202502c0> ; LeaderLineType = "ByLayer" ; LeaderLineWeight = -1 ; LeaderType = 1 ; Linetype = "ByLayer" ; LinetypeScale = 1.0 ; Lineweight = -1 ; Material = "ByLayer" ; ObjectID (RO) = 2023740648 ; ObjectName (RO) = "AcDbMLeader" ; OwnerID (RO) = 2023734520 ; PlotStyleName = "ByLayer" ; ScaleFactor = 1.0 ; StyleName = AutoCAD.Application: Объект был стерт ; TextBackgroundFill = 0 ; TextDirection = 5 ; TextFrameDisplay = 0 ; TextHeight = 2.5 ; TextJustify = 3 ; TextLeftAttachmentType = 3 ; TextLineSpacingDistance = 4.16667 ; TextLineSpacingFactor = 1.0 ; TextLineSpacingStyle = 1 ; TextRightAttachmentType = 3 ; TextRotation = 0.0 ; TextString = "Выноска" ; TextStyleName = "M_ru-Standard" ; TextWidth = 0.0 ; TrueColor = #<VLA-OBJECT IAcadAcCmColor 20250260> ; Visible = -1

Соответственно

Код:

[Выделить все]

(vla-get-StyleName (vlax-ename->vla-object (car (entsel))))

вернула:

; ошибка: Ошибка Automation. Объект был стерт

Меня всё это весьма настораживает.

[Кулик Алексей aka kpblc]

ну кто ж знал-то Тогда остается только действительно проходить по всей базе:

Код:

[Выделить все]

(defun purge-mleader-styles (/ fun_get-all-entities-in-space style_lst doc err)

  (defun fun_get-all-entities-in-space (space / res)
                                       ;|
*    Получение списка vla-указателей примитивов текущего документа
* и указанного владельца.
* Проходит по блокам и внешним ссылкам. Не обрабатывает именованные виды (adt).
* Вхождения блоков не учитываются в результирующем списке.
*    Параметры вызова:
*	space	пространство или описание блока (внешней ссылки), по которому
		надо "пройтись". nil -> текущее пространство.
*    Примеры вызова:
|;
    (vlax-for ent (cond
                    ((and space (= (vla-get-objectname ent) "AcDbBlockReference"))
                     (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vla-get-name space))
                     )
                    ((and space
                          (and
                            (= (strcase (vla-get-objectname ent) t)
                               "acdbblocktablerecord"
                               ) ;_ end of =
                            (wcmatch (setq name (strcase (vla-get-name ent) t)) "*_space*")
                            (= (substr name 1 1) "*")
                            (= (substr name (1+ (strlen name))))
                            ) ;_ end of and
                          ) ;_ end of and
                     space
                     )
                    (t (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
                    ) ;_ end of cond
      (if (= (vla-get-objectname ent) "AcDbBlockReference")
        (setq res (append (fun_get-all-entities-in-space ent) res))
        (setq res (cons ent res))
        ) ;_ end of if
      ) ;_ end of vlax-for
    ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (if (vl-catch-all-error-p
        (setq err
               (vl-catch-all-apply
                 (function
                   (lambda ()
                     (foreach style (mapcar (function vla-get-stylename)
                                            (vl-remove-if-not
                                              (function
                                                (lambda (x)
                                                  (= (vla-get-objectname x) "AcDbMLeader")
                                                  ) ;_ end of lambda
                                                ) ;_ end of function
                                              (fun_get-all-entities-in-space nil)
                                              ) ;_ end of vl-remove-if-not
                                            ) ;_ end of mapcar
                       (if (not (member style style_lst))
                         (setq style_lst (cons style style_lst))
                         ) ;_ end of if
                       ) ;_ end of foreach
                     (vlax-for style (vla-item (vla-get-dictionaries doc) "ACAD_MLEADERSTYLE")
                       (if (not (member (vla-get-name style) style_lst))
                         (vla-delete style)
                         ) ;_ end of if
                       ) ;_ end of vlax-for
                     ) ;_ end of lambda
                   ) ;_ end of function
                 ) ;_ end of vl-catch-all-apply
              ) ;_ end of setq
        ) ;_ end of vl-catch-all-error-p
    (princ (strcat "\n ** ERROR : " (vl-catch-all-error-message err)))
    ) ;_ end of if
  (vla-endundomark doc)
  (princ)
  ) ;_ end of defun

[Makswell]

Алексей , спасибо! Далеко не в первый раз выручаешь.