[Nickolay]

Есть набор DXF файлов, созданных при экспорте из PCAD2002. Содержат большое количество блоков многоуровневой структуры (команда INSERT). Можно ли как-то автоматизировать процесс (Лисп программа) select Block -> explode -> purge. На выходе нужно получить DWG состоящий только из 2D полилиний и текста. Может у кого есть какие-нибудь заготовки или готовый код. Буду признателен за любую помощь

[Лентяй]

Код:

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

 (defun C:AlQaida (/);Взрывает все на хрен!
  (setq cm (getvar "CMDECHO")
	adoc (vla-get-activedocument (vlax-get-acad-object))
   	bks (vla-get-blocks adoc)
	ps (vla-get-PaperSpace adoc)
   	ms (vla-get-ModelSpace adoc))
  (apply '(lambda (x)
	    (vlax-for obj sp
	      (if (and (= (vla-get-objectname obj) "AcDbBlockReference")
		       (= (vla-get-IsXref (vla-item bks (vla-get-name obj))) :vlax-false))
		(vla-explode obj)))) '(ps ms))
  (repeat 3 (command "purge" "all" "y"))
);end

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

> Лентяй : можно вместо

Код:

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

(repeat 3 (command "purge" "all" "y"))

Сделать

Код:

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

(repeat 3 (vla-PurgeAll (vla-get-ActiveDocument (vlax-get-acad-object))))

И вот еще - иногда по необъяснимым причинам после (vla-explode) может слететь положение блока. Более подробно описано в "САПР на базе AutoCAD". Надеюсь, авторы против не будут:

...особенность (явный глюк) 2004-ого когда при расчленении безымянного блока он сбрасывает результат в точку вставки безымянного блока + точку использованную при его определении...

Решено это в последующих версиях или нет, я не знаю.

[Лентяй]

Категорически согласен, потому как сам не люблю использовать "command", когда можно по-людски ActiveX-ом. Хотя метода "PurgeAll" в ADT, котороя у меня установлена на работе, не нашел. Так что мерси за науку.

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

> Лентяй : странно, что в ADT нет этой функции. Она же базовая для када, насколько я понимаю. Только что проверил на ADT 2005 Eng и ADT 2006 Eng, работает.

[Лентяй]

Я не сказал, что ее там нет. Я сказал, чтоя ее не нашел. М.б. плохо искал - все-таки день предпраздничный, все - лениво-пох, непосредственное начальство, опять же, осталось дома индюка жарить, так что никакого рвения ожидать не приходилось, по каковой же причине таковое и не наблюдалось. Вот в понедельник со свежими силами похмелья апосля на службу выйду, тогда и проверю.

[Nickolay]

Спасибо за помощь Лентяй. Поскольку я не пользователь AutoCad, а электронщик, есть еще пару вопросов, может быть глупых. Наш конструктор работает в Mechanical Desktop (MDT6) и несколько далек от LISP. Как запустить программу! Я сохранил код *.vlx (пробовал и *.lsp), затем _appload – в списке загруженных приложений есть. При вызове по имени функции пробовал и с подчеркиванием и в скобках – ругается функция не определена.

[Vook]

Сообщение от Лентяй Код: [Выделить все] (defun C:AlQaida (/);Взрывает все на хрен!

Но взрывает-то все в одном файле, а нужно в наборе

[algol2]

2 Лентяй
Не знаю как у кого, но у меня на 2004 и при (vl-load-com) вываливается ; error: too many arguments на '(ps ms). Что не так делаю?

[Лентяй]

Vook: Но взрывает-то все в одном файле, а нужно в наборе

Желаете быть ленивее меня? Не позволим-с! :evil: Впрочем, держите update. Взорвет все на хрен в указанной директории.

Код:

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

(defun C:AlQaida (/ acobj kw cmd dir file_list adoc);Взрывает все на хрен!
  (vl-load-com) 
(setq cmd (getvar "CMDECHO")
	acobj (vlax-get-acad-object))
  (initget "Opened List")
  (setq kw (getkword "\nPurge Opened File or <List>: [Opened/List]?"))
  (if (null kw) (setq kw "List"))
  (cond ((= kw "List")
	 (setq adoc (vla-getinterfaceobject acobj "ObjectDBX.AxDbDocument.16")
	       dir (vl-filename-directory (getfiled "Select Single File" "" "dwg" 8))
	       file_lst (cddr (vl-directory-files dir "*.dwg" 1)));setq
	 (foreach dwg file_lst (vla-open adoc (findfile (strcat dir "\\" dwg)))
	   (bprg adoc)));List
	((= kw "Open") (setq adoc (vla-get-activedocument acobj)) (bprg adoc)));cond
  (setvar "CMDECHO" cmd)
);end
;
(defun bprg (adoc / bks sps)
  (setq bks (vla-get-blocks adoc)
	sps (mapcar '(lambda (sp) (vlax-get-property adoc sp)) '(PaperSpace ModelSpace)))
  (apply '(lambda (x)
      (vlax-for obj x 
         (if (and (= (vla-get-objectname obj) "AcDbBlockReference") 
             (= (vla-get-IsXref (vla-item bks (vla-get-name obj))) :vlax-false)) 
      (vla-explode obj)))) sps)
    (repeat 3 (vla-purgeAll adoc))
    (vla-save adoc)
);bprg

>Nikolaj
Вы все делали правильно, впрочем, сохрайть файл следовало как *. Вызов команды производится печатанием в командной строке имени программы. Попробуйте дополненный код.

[Apog]

помогите!
как после того так пользователь разместил какойнибудь элемент, например прямоугольник или полилиния система автоматически его разбила!!! спасибо

[Profan]

А на хрен там полилинии, взорвать на хрен.

[Apog]

ну а если серьезно?? помогите пожалуйста!

[WhiteShark]

Сообщение от Лентяй (apply '(lambda (x) (vlax-for obj x (if (and (= (vla-get-objectname obj) "AcDbBlockReference") (= (vla-get-IsXref (vla-item bks (vla-get-name obj))) :vlax-false)) (vla-explode obj)))) '(ps ms))

Вот даже после исправления выделенной опечатки все равно получаю сообщение "error: too many arguments". Подскажите, в чем дело? Второй вариант проги принципиально не отличается в этом моменте, но, видимо, работает?

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

А на момент вызова ps и ms чему равны?

[WhiteShark]

Ну, очевидно, как написано в начале программы (setq ps (vla-get-PaperSpace adoc) ms (vla-get-ModelSpace adoc)) это VLA-object'ы соответствующих спэйсов. Они точно не nil (если это тут вообще при чем-то). VLISP IDE говорит что брейк происходит именно на вызове лямбдыю

[gomer]

WhiteShark, какой у вас автокад и его разрядность? Я нашел в этой каиде 2 ошибки и не понимаю как оно вообще работало

Вот вам нормальный вариант

Код:

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

 (defun C:AlQaida (/)

;;; Взрывает все на хрен!
;;; Revised 07/01/2013 by gomer

  (vl-load-com)
  
  ((lambda (adoc)
     (mapcar
       (function
	 (lambda (sp)
	   (vlax-for obj sp
	     (if
	       (and (= "AcDbBlockReference" (vla-get-objectname obj))
		    (= :vlax-false
		       (vla-get-IsXref
			 (vla-item (vla-get-blocks adoc)
				   (vla-get-name obj)
			 )
		       )
		    )
	       )
		(progn (vla-explode obj) (vla-delete obj))
	     )
	   )
	 )
       )
       (list (vla-get-ModelSpace adoc) (vla-get-PaperSpace adoc))
     )
     (repeat 3 (vla-purgeAll adoc))
   )
    (vla-get-activedocument (vlax-get-acad-object))
  )

  (princ)

)

Беда в том, что связка vla-StartUndoMark и vla-EndUndoMark почему-то не хотят работать, а без них отмена работает не корректно
Например, создаю блок в пустом файле, копирую его, запускаю алькаиду, затем жму кнтрлзет и получаю один созданный блок вместо всех скопированных

[WhiteShark]

Спасибо огромное за внимание, gomer! Буду теперь ваш код осмыслять )
Кад у меня 2012х64, но работать у меня лично она и не работала. Я просто подумал, что раз никто не возмущался, то а) она работает б) никто так и не пользовался. Видимо, оказался вариант "б"
А не подскажите, какие именно 2 ошибки? А то я только одну увидел (и то, может третью).
И пару вопросов, раз уж вы под руку попались: 1. как вы так красиво оформляете код
2. (отвлеченный) Вот если мне надо в конце работы вывести значение на экран princ'ом, но я не хочу его дублировать, то я опять пишу princ. Но тогда последним вычисленным значением становится nil. А мне надо, чтоб функция возвращала то, что я хотел вывести на экран. Как это сделать без задействования глобальных переменных?

[gomer]

1. apply вместо mapcar, это как раз и выдавало ошибку количества аргументов
2. в лямбду по сути предавались не ms и ps а (quote ms) и (quote ps)
+ 3. программа не удаляла взрываемые блоки

1. это определенные правила оформления, я просто ими пользуюсь
2. сформулируйте задачу более конкретно, а то не понятно

[Do$]

Блоки лучше взрывать при помощи BURST а не простым EXPLODE.