[Кочетков Андрей]

Господа программисты! Опять нужна ваша помощь.
Проблема в следующем: имеется 13000 трехмерных полилиний.
Необходимо их взорвать.
Если их все выделить и дать команду EXPLODE то Акад виснет наглухо.
Если делать это по частям, то получается очень долго.

Поэтому у меня просьба написать следующую программу:
выделяем объекты, запускаем программу
Программа применяет команду EXPLODE (желательно через activex для увеличения скорости) к каждому объекту в наборе.
При этом в командной строке выводится надпись:
Всего объектов: УУУ. Осталось: ХХХ.
Эта надпись обновляется после взрывания каждого примитива (как в Тулпаке).

Мне это нужно для оценки времени работы.

[Лентяй]

Послушайте, Кочетков Андрей, вы - мерзкий провокатор! Вы думали, подсунете мне 2905 ЗАМКНУТЫХ полилиний, у которых значение кода 70 равно 9 (8 -3D) + 1 -замкнутая), так я, не зная как всунуть сложный фильтр, сдамся на милость ssget-чиков? Не дождетесь! :twisted: Держите чистый AcnbveX со сложным фильтром, позволяющим выбирать 70=8 и 70=9:

Код:

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

(defun C:3D-PLnExpl ( / adoc flt ass lyrs opt m) 
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))
        flt (list (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 4)) '(0 -4 70 70 -4))
(vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 4)) (list "Polyline" "<OR" 8 9 "OR>"))))
  (mapcar '(lambda (x y) (set x (vlax-get-property adoc y))) '(ass lyrs util)
    '(ActiveSelectionSet Layers Utility))
  (vla-StartUndomark adoc)
  (if (> (vla-get-count ass) 0) (vla-clear ass))
  (vla-InitializeUserInput util 128 "Все ВЫбрать")
  (setq opt (vla-getKeyword util "Взрывать [Все/ВЫбрать]: <Все>"))
  (if (= "" opt)(setq opt "Все"))
  (if (= opt "Все") (vla-select ass acSelectionSetAll nil nil (car flt) (cadr flt))
    (vla-selectOnscreen ass (car flt) (cadr flt)));if
  (if (> (setq i (vla-get-count ass)) 0)
    (progn (vlax-for obj ass
        (if (= (vla-get-lock (vla-item lyrs (vla-get-layer obj))) :vlax-true)
          (vla-removeItems ass (vlax-make-variant (vlax-safearray-fill
                (vlax-make-safearray vlax-vbObject '(0 . 0)) (list obj))))));vlaxfor
      (if (> (setq m (vla-get-count ass)) 0)
        (if (> (setq dc (load_dialog "progress.dcl")) 0)
          (if (new_dialog "progress" dc) (progn
              (set_tile "cnt1" (strcat "Выбрано " (itoa i) " полилиний"))
              (set_tile "cnt2" (strcat "Возможно взорвать " (itoa m) " полилиний"))
              (action_tile "start" "(expl ass  m)")
              (start_dialog) (done_dialog) (unload_dialog dc) (gс));progn
            (princ "\nНе загрузить диалог progress. "));if
          (princ "\nНе найден файл progress.dcl. "));if
        (alert "\nВсе, что можно, уже взорвано. Чеченцы ушли.")));progn
      (alert "\nНечего не найдено"));if
  (vla-EndUndomark adoc)
  (princ)
);end
;-------------------------------------------
; Cоздано © А.Д. Шейнкман a.k.a. Лентяй
;на основе Приложения 3\pbar.lsp
; © Н.Н.Полещук, 2006 г.
; В книге: Н.Н.Полещук, П.В.Лоскутов
;"AutoLISP и Visual LISP в среде AutoCAD"
; (издательство "БХВ-Петербург", 2006)
(defun expl (ass m / n)
  (setq n 0)
  (mode_tile "start" 1)
  (set_tile "ttl" "Пожалуйста подождите. Программа выполняется...")
  (vlax-for obj ass (vla-explode obj) (vla-delete obj)
    (setq n (1+ n))
    (start_image "img")
    (fill_image 0 0 (/ (* (dimx_tile "img") n) m) (dimy_tile "img") 5)
    (end_image)
    (set_tile "cif" (strcat (rtos (* (/ (float n) m) 100) 2 1) "%")));vlax-for
  (if (= (get_tile "cif") "100%")
    (set_tile "res" (strcat "Всего взорвано " (itoa m) " полилиний")));if
  (gc)
);expl

[AY]

И все-таки сглаженные 3d-полилинии могут иметь зачение 70-го кода еще и 12 и 13. Поэтому для достоверного выбора всех 3D-полилиний как мне кажется надо применять фильтр:

Код:

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

(ssget '((0 . "POLYLINE")
         (-4 . "<AND")
         (-4 . ">")
         (70 . 7)
         (-4 . "<")
         (70 . 16)
         (-4 . "AND>")
        )
)

Вообщем я предлагаю так :)

Код:

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

(defun c:expode-3dpolyline (/ lay doc er lines x i str) 
    (vl-load-com) 
    (setq doc (vla-get-activedocument (vlax-get-acad-object))) 
 ;(vla-endundomark doc) 
    (vla-startundomark doc) 
    (setq er (vl-catch-all-apply 
                 '(lambda () 
;============================================================
(princ "\nВыберите 3D-полилинии для разбиения...")
(if (setq lines (ssget '((0 . "POLYLINE")(-4 . "<AND")
                            (-4 . ">")(70 . 7)
                            (-4 . "<")(70 . 16)(-4 . "AND>"))))
    (progn
        (setq lay (vla-get-layers doc)
              i   (sslength lines)
              str (strcat "Всего объектов:  "
                          (itoa i)
                          ". Осталось объектов: "
                  )
        )
        (princ "\nПожалуйста подождите. Программа выполняется...\n")
        (foreach x (ssnamex lines)
            (if (and (not (listp (setq x (cadr x))))
                     (setq x (vlax-ename->vla-object x))
                     (= (vla-get-lock (vla-item lay (vla-get-layer x)))
                        :vlax-false
                     )
                )
                (progn
                    (setq i (1- i))
                    (princ (strcat str (itoa i) ".\r"))
                    (vla-explode x)
                    (vla-delete x)
                )
            )
        )
        (princ "\nПрограмма закончила работу.")
        (gc)
    ) ;progn
       (princ "\nОбъектов не найдено.")
) ;if
;============================================================ 
                  ) ;_ lambda 
             ) ;_ vl-catch-all-apply 
    ) 
    (if (vl-catch-all-error-p er) 
        (princ (vl-catch-all-error-message er)) 
    ) ;_ if 
    (vla-endundomark doc) 
    (princ) 
);the end

p.s. Кстати куда это крыс пропал?

[Кочетков Андрей]

>>Лентяй
Да-да. Я такой. [sm2907]

Ну товарищи, вы меня в очередной раз потрясли своим знанием Лиспа.
А прогресс бар так это вообще из серии евро-ремонта
Спасибо!

А теперь немного статистики:
- задача: взорвать 2905 замкнутых трехмерных полилиний
1. используем встроенную команду explode
время выполнения операци: 60 секунд
время выполнения команды UNDO: 10 секунд
2. используем написанные выше программы:
время выполнения: от 3 до 5 секунд
UNDO: меньше секунды

Даже не знаю какой вывод сделать. Переписать что ли все команды Автокада

[kakt00z]

Приветствую!
подскажите пожалуйста, можно ли в аргумент _explode вставить набор ssget ?
нужно разбить все MTEXTы в модели
пробую писать следующее:

Код:

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

(defun mtxt-total-explode (/ ss)
  (if
    (setq ss (ssget "_X"
		    '((0 . "MTEXT"))
	     )
    );setq
     (progn
       (command "_explode" ss)
     );progn
  );if
);defun

пробовал в разных вариациях, vl-cmdf, и т.д. но не получается
может кто-нибудь сможет обьяснить что ему надо?

[CB]

Код:

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

 
(sssetfirst nil (ssget "_X" '((0 . "MTEXT"))))
(command "_explode")

[VVA]

Уточнение к #25 PICKFIRST должно быть равно 1
Как программно "взорвать" блоки?