[Jurasic]

Для своих нехитрых нужд написал програмку, которая заменяет дуги, эллипсы или эллиптические дуги окружностями того же радиуса (для эллипсов - MajorRadius). Программа работает один раз при загрузке. Потом вылетает с ошибкой "Automation Error. Calling method AddItems of interface IAcadSelectionSet failed" Если после этого выполнить команды Copy или Move (вобщем любую связанную с созданием нового набора примитивов) она опять работает еще один раз.. Если закоментировать в тексте программы цикл отвечающий за стирание объектов из ActiveSelectionSet программа работает, но не стирает исходные дуги и эллипсы. Ответа ни на dwg.ru ни на autocad.ru не нашел Что я не так делаю?? Помогите!
[ATTACH]1143449371.zip[/ATTACH]

[VVA]

удалено

[vk]

1. Что то не улавливаю, какой тайный смысл использовать vla-SelectOnScreen вместо чисто лисповской исходной функции ssget ?
2. Навскидку '("<AND" "ARC,ELLIPSE" "AND>") кажися "<AND" и "AND>" не нужны

[Jurasic]

Да, точно... Но ответа там нет... Через банальный lisp я могу это сделать без проблем... Но хочется с ActiveX'ом разобраться!! Подождем!!

[Jurasic]

To VK без <AND AND> - не работает.. На счет vla-SelectOnScreen... Он то как раз видимо работает но при стирании объектов из ActiveSelectionSet происходит ошибка какая-то. Может кто сталкивался с этим...

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

Несколько моментов.
1. Определение активного пространства. При работе в модели через лист будет возвращаться не то, что надо. Вариант определения есть здесь
2. По-моему, очищать набор мало. Надо бы его и удалить (это не релиз объекта, а именно удаление). Посмотри на vbamaker.narod.ru - там операции с наборами через VBA идут, но аналог провести можно.

[Jurasic]

To kpbIc Спасибо! С моделью и листом действительно были глюки, исправил... Пробовал и стирать и чистить. И сначала удалял объект из набора, потом стирал его и стирал весь набор - глюк один и тот же!!

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

Слушай, я полностью код не смотрел, попробуй нечто типа такого:

Код:

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

(defun c:jcirclefromarc	()
  (setq *doc* (vlxx-activedocument))
  (if ass
    (progn
      (vla-clear ass)
      (vla-erase ass)
      ) ;_ end of progn
    ) ;_ end of if
  (if (not (vl-catch-all-error-p
	     (vl-catch-all-apply 'vla-get-activeselectionset (list *doc*))
	     ) ;_ end of vl-catch-all-error-p
	   ) ;_ end of not
    (setq ass (vla-get-activeselectionset *doc*))
    ) ;_ end of if
  (vla-startundomark *doc*)

Ну и далее по тексту.
Знатоком ActiveX не числюсь, надо ждать Лентяя или Apelsinov'a.

[Jurasic]

To kpbIc: Ошибка происходит в строке (setq ass (vla-get-ActiveSelectionSet *doc*)), потому что в свойствах AcadDocument в свойстве ActiveSelectionSet сидит такая ошибка error: Automation Error. Calling method AddItems of interface IAcadSelectionSet failed (смотрел через inspeсt), поэтому что clear ее, что delete - все равно.. vl-catch-all-error-p возвращает ошибку (T) поэтому дальше ниче не выполняется..

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

Погоди, а внутрь if'a у тебя вход что, выполняется?

[Jurasic]

Нет, не выполняется! Сорри, сначала не полностью ответил.....

[Jurasic]

И на

Код:

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

(if ass 
    (progn 
      (vla-clear ass) 
      (vla-erase ass) 
      ) ;_ end of progn 
    )

ругается error: null interface pointer: #<VLA-OBJECT 00000000>

[Apelsinov]

Jurasic
Итак разбор полетов:
***

Код:

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

(setq *vlxx-acadobject* nil)

- не понятно зачем обнулять все глобальные - это от чего защита-то?
если от того, что какая-то бяка им что-то назначит- так она им и после загрузки этого лиспа наприсваивать может...
***
vlxx-ActiveSpace- это Крыс прошелся уже...
***
vlxx-AddCircle Значит, что оно делает:
оно вставляет в пространство окружность (я бы тут защиту поставил, а то вдруг там слой залочен или еще что...), затем присваивает ей свойства. А потом вдруг (entlast) - нет уж activeX так activeX. А то фигня это. Если уж очень надо, то vlax-vla-object->ename, а сдесь можно и просто obj вернуть.
***
C:JCirclefromAr

Код:

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

(setq *doc* (vlxx-ActiveDocument))

- не понятно, зачем тогда vlxx-ActiveDocument писали с глобальной переменной.

Код:

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

(vla-startundomark *doc*)

- а почему оно после (setq ass ... и т.п.?

Код:

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

(setq    JCenterPoint nil ...

и т.д засунул в список локальных - и забыл (и во избежание глюков ВСЕ локальные туда!)

Код:

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

(vla-SelectOnScreen    ass ...

вот собсно, нафига сдесь именно ass? ведь можно любую sel.set, авось и глюков будет поменьше.

Код:

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

(if (vlax-property-available-p *acadObj* 'Radius)
	  (setq JRadius (vlax-get-property *acadObj* 'Radius))
	)

Вот это по-нашему, только я бы отдельную функцию сделал на присвоение свойства. ну или хотяб лямбду, чтоб не повторяться...

Код:

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

(vlax-release-object *acadObj*)

- вот,я , честно, не знаю зачем оно надо.

Код:

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

(vlax-for *acadObj* ass
    (vla-delete *acadObj*)

- ето понятно, хотя на слой надобы все-же проверочку.

а вот теперь как раз неплохо бы -

Код:

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

(vla-clear ass)

перефразируя Лентяя - уважайте Мойдодыра.

Код:

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

(vla-endundomark *doc*)

- это так, конечно, но неплохо бы эту хрень нафигачить и в обработчик ошибок, которого тут нету.

P/S/
никаких НАБОРОВ тут нет, и неоткуда.
то что ass потом ругается - это уже последствия, ищите причину.

[Jurasic]

To Apelsinov Спасибо за конструктивную критику! Со всем согласен, кроме: "зачем обнулять все глобальные" - если файл только что открыт, или программа только что загружена, *vlxx-activedocument* вернет указатель на прошлый файл ибо MDI!! И т.д.....
В "эту хрень" можно "нафигачить" и обработчик ошибок и еще кучу проверок, но ответа на вопрос так и не получить..... А вопрос простой: как стереть (вообще/совсем) стереть из чертежа исходные объекты, так чтобы не портить ActiveSelectionSet??

[Jurasic]

Сообщение от Apelsinov Jurasic P/S/ никаких НАБОРОВ тут нет, и неоткуда.

Из Хелпа: SelectionSet - object; read-only
The active selection set for the drawing.
Т.е. По русски говоря - активный набор, хотя и объект. ИМХО

[Apelsinov]

Jurasic

*vlxx-activedocument* вернет указатель на прошлый файл ибо MDI!! И т.д.....

ФИГУ! С какого будуна он вернет прошлый файл, если эта глобальная переменная ЭТОГО файла?

но ответа на вопрос так и не получить..... А вопрос простой: как стереть (вообще/совсем) стереть из чертежа исходные объекты, так чтобы не портить ActiveSelectionSet??

Вы не поверите, но у меня это получается легко, и вот такой код работает на ура:

Код:

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

(vlax-for i (APEL-ssget nil)
  (vla-delete  i)
)

могу дать код для APEL-ssget - там это тоже через vla-SelectOnScreen, но много польз функций.
найти что именно приводит к Вашей ошибке может и не получится, это такие дебри... А вот если Вы залатаете все дырочки в программе (локальные, очистка и т.п.) то и ошибка исчезнет, ибо она где-то там. Ну и еще, возможно, стоит отказаться от ass и заполнять свой обьект выбора, попутно его создавая.

НАБОР - это то что вернет (ssget). Это из другой песни.

[Jurasic]

Всем спасибо! KpbIc'у и Apelsinov'у особенно! Выкладываю последний вариант программы, может кому понадобится...
Еще раз напомню что программа заменяет выделенные дуги и эллипсы соответствующими по радиусу окружностями. Для эллипсов за радиус берется MajorRadius.
[ATTACH]1143532346.zip[/ATTACH]

[Лентяй]

Сообщение от kpblc Знатоком ActiveX не числюсь, надо ждать Лентяя или Apelsinov'a.

Спасибо, kpblc! Доброе слово, оно, знаете, и кошке... [sm154]

Дорогой Jurassic ,
Хоть меня тут и держат зазнатока, но код ваш ниаслил, потому как он мудер больно. Хотя фильтр с "или" мне понравился.
Я тут выкидывал как-то прграммку на несколько строк, но работающую, так что держите ее снова.

Код:

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

(defun C:A2C (/ ark ent csp cpt rad kw)
  (initget "Last Select")
  (setq kw (getkword "\nLast Ark or <Select> [Last/Select]: ?"))
  (if (null kw) (setq kw "Select"))
  (setq ark (vlax-ename->vla-object (if (= kw "Select") (car (entsel)) (entlast)))
        csp (vlax-invoke (vla-get-ActiveDocument (vlax-get-acad-object)) "ObjectIDtoObject" (vla-get-ownerID ark))
        cpt (vla-get-Center ark)
        rad (vla-get-Radius ark));setq
  (vla-addCircle csp cpt rad)
  (vla-delete ark)
);end

А если вам хочется с набором, то вот вам такой вариант

Код:

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

(defun C:A2C-vx (/ adoc util csp kw)
  (defun a2c (ark / cpt)
    (setq cpt (vla-get-center ark))
    (cond ((vlax-property-available-p ark 'Radius)
           (vla-addCircle csp cpt (vla-get-radius ark)))
          ((vlax-property-available-p ark 'MajorRadius)
           (vla-addEllipse csp cpt (vla-get-MajorAxis ark) (vla-get-RadiusRatio ark))))
    (vla-delete ark)
  );end_c2a
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))
        util (vla-get-utility adoc)
        ass (vla-get-ActiveSelectionSet adoc))
  (if (> (vla-get-count ass) 0) (vla-clear ass))
  (vla-endundomark adoc)
  (vla-startundomark adoc)
  (vla-InitializeUserInput util 128 "Last Select")
  (setq kw (vla-getKeyWord util "\nLast Ark or <Select> [Last/Select]: ?"))
  (if (= kw "") (setq kw "Select"))
  (setq csp (if (= (getvar "CVPORT") 1) (vla-get-PaperSpace adoc) (vla-get-ModelSpace adoc)))
  (if (= kw "Select")
    (progn
      (vla-SelectOnScreen ass (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 2)) '(-4 0 -4))
        (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 2)) '("<AND" "ARC,ELLIPSE" "AND>")))      
      (vlax-for ark ass (a2c ark)));progn
    (progn
      (setq ark (vla-item csp (1- (vla-get-count csp))))
      (a2c ark));progn
  );if
  (vla-endundomark adoc)  
);end

[Лентяй]

Дорогой Jurassic ,
Пока я ваял свой вариант, вы уже успели вылодить новую версию вашей программы. Не могу не отметить, что она не сыободна от недостатков предыдущей, как-то: перегружена переменными, каждое свойство вновь созданного обрабатывается отдельно, хотя для этого удобнее использовать списки и т.д.
Предлагаю вам свой вариант, в котором окружность (эллипс) наследуют свойства дуги, из которой они образуются. Это всего лишь требует введения двух(!) операций в мою вспомогательную функцию а2с:

Код:

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

(defun a2c (ark / obj cpt)
    (setq cpt (vla-get-center ark)
          prp (mapcar '(lambda (x) (vlax-get-property ark x))
                '(Layer Color LineType)); ЗАПИСЫВАЕМ СВОЙСТВА ДУГИ
          obj (cond ((vlax-property-available-p ark 'Radius)
                     (vla-addCircle csp cpt (vla-get-radius ark)))
                    ((vlax-property-available-p ark 'MajorRadius)
                     (vla-addEllipse csp cpt (vla-get-MajorAxis ark) (vla-get-RadiusRatio ark)))); ПРИСВАИВАЕМ ИМЯ НОВОМУ ОБЪЕКТУ
    );setq
    (mapcar '(lambda (x y) (vlax-put-property obj x y))
      '(Layer Color LineType) prp); ПРИСВАИВАЕМ СВОЙСТВА ДУГИ НОВОМУ ОБЪЕКТУ
    (vla-delete ark)
  );end_c2a

[Jurasic]

Лентяй! Долго же вас не было!!!! Я уже свой код домучал...... Первый ваш - супер, коротко и работает... Только Apelsinov мне уже за (entlast)'ы в смеси с ActiveX'ом навалял , а вторая (по крайней мере у меня) выдает такую же ошибку при повторном запуске: Automation Error. Calling method AddItems of interface IAcadSelectionSet failed