Нужен Лисп: программный EXPLODE выделенных объектов

Кочетков Андрей · 10.08.2006, 17:57

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

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

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

AY · 10.08.2006, 19:23

Могу на первое время подкинуть такой вариант:

Код:

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

(defun c:expode-3dpolyline (/ obj lay doc er lines 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 ()
;============================================================
(setq lay   (vla-get-layers doc)
    lines (ssnamex (ssget "_X" '((0 . "POLYLINE") (70 . 8))))
    i     (length lines)
    str   (strcat "Всего объектов:  "
                  (itoa i)
                  ". Осталось объектов: "
          )
)
(princ "\nПожалуйста подождите. Программа выполняется...\n")

(foreach index lines
  (setq obj (vlax-ename->vla-object (cadr index)))
  (if
      (= (vla-get-lock (vla-item lay (vla-get-layer obj)))
         :vlax-false
      )
         (progn
             (setq i (1- i))
             (princ (strcat str (itoa i) ".\r"))
             (vla-explode obj)
             (vla-delete obj)
         )
  )
)
(princ "\nПрограмма закончила работу.")
(gc)
;============================================================
                  ) ;_ lambda 
             ) ;_ vl-catch-all-apply 
    )
    (if (vl-catch-all-error-p er)
        (princ (vl-catch-all-error-message er))
    ) ;_ if 
    (vla-endundomark doc)
    (princ)
)

В этом варианте объекты на закрытых слоях игнорируются.

p.s. Чуть подправил код в 23.41

Кочетков Андрей · 11.08.2006, 09:37

AY спасибо

При запуске появляется ошибка:

Код:

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

Command: explode-3dpolyline
bad argument type: lselsetp nil

Ошибка возникате в лямбда-функции.
Может я что не так делаю?

Кулик Алексей aka kpblc · 11.08.2006, 09:53

Попробуй это:

Код:

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

(defun c:x3d (/			  adoc		      selset
	      counter		  *error*	      layer_status_lst
	      loc:layer_status_save		      loc:layer_status_restore
	      )
  (defun *error* (msg)
    (loc:layer_status_restore)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (defun loc:layer_status_save ()
    (vlax-for item (vla-get-layers adoc)
      (setq layer_status_lst
	     (append
	       layer_status_lst
	       (list (list item
			   (cons "freeze" (vla-get-freeze item))
			   (cons "lock" (vla-get-lock item))
			   ) ;_ end of list
		     ) ;_ end of list
	       ) ;_ end of append
	    ) ;_ end of setq
      (vla-put-lock item :vlax-false)
      (vl-catch-all-apply 'vla-put-freeze (list item :vlax-false))
      ) ;_ end of vlax-for
    ) ;_ end of defun

  (defun loc:layer_status_restore ()
    (foreach item layer_status_lst
      (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
      (vl-catch-all-apply
	'vla-put-freeze
	(list (car item) (cdr (assoc "freeze" (cdr item))))
	) ;_ end of VL-CATCH-ALL-APPLY
      ) ;_ end of foreach
    ) ;_ end of defun

  (vl-load-com)
  (setq	adoc	(vla-get-activedocument (vlax-get-acad-object))
	counter	1
	) ;_ end of setq
  (vla-startundomark adoc)
  (loc:layer_status_save)
  (setq	selset
	 (mapcar 'vlax-ename->vla-object
		 (vl-remove-if
		   'listp
		   (mapcar 'cadr (ssnamex (ssget "_X" '((0 . "*POLYLINE")))))
		   ) ;_ end of vl-remove-if
		 ) ;_ end of mapcar
	) ;_ end of setq
  (foreach item	selset
    (vla-explode item)
    (vla-erase item)
    (princ (strcat "\nОбработана полилиния : "
		   (rtos counter 2)
		   " из "
		   (rtos (length selset) 2)
		   ) ;_ end of strcat
	   ) ;_ end of princ
    (setq counter (1+ counter))
    ) ;_ end of foreach
  (loc:layer_status_restore)
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

AY · 11.08.2006, 09:54

Надо полагать в чертеже нет полилиний. Исправлю. Попробуй в чертеже с полилиниями.

Кочетков Андрей · 11.08.2006, 11:29

>>AY
Они там есть

>>Krblc
Работет!
А можно изменить программу так, чтобы она применялась не ко всем объектам чертежа, а только к выделенным (чтобы перед запуском был диалог на выбор объектов)?

Кулик Алексей aka kpblc · 11.08.2006, 11:32

всего 4 символа снес

Код:

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

(defun c:x3d (/			  adoc		      selset
	      counter		  *error*	      layer_status_lst
	      loc:layer_status_save		      loc:layer_status_restore
	      )
  (defun *error* (msg)
    (loc:layer_status_restore)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (defun loc:layer_status_save ()
    (vlax-for item (vla-get-layers adoc)
      (setq layer_status_lst
	     (append
	       layer_status_lst
	       (list (list item
			   (cons "freeze" (vla-get-freeze item))
			   (cons "lock" (vla-get-lock item))
			   ) ;_ end of list
		     ) ;_ end of list
	       ) ;_ end of append
	    ) ;_ end of setq
      (vla-put-lock item :vlax-false)
      (vl-catch-all-apply 'vla-put-freeze (list item :vlax-false))
      ) ;_ end of vlax-for
    ) ;_ end of defun

  (defun loc:layer_status_restore ()
    (foreach item layer_status_lst
      (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
      (vl-catch-all-apply
	'vla-put-freeze
	(list (car item) (cdr (assoc "freeze" (cdr item))))
	) ;_ end of VL-CATCH-ALL-APPLY
      ) ;_ end of foreach
    ) ;_ end of defun

  (vl-load-com)
  (setq	adoc	(vla-get-activedocument (vlax-get-acad-object))
	counter	1
	) ;_ end of setq
  (vla-startundomark adoc)
  (loc:layer_status_save)
  (setq	selset
	 (mapcar 'vlax-ename->vla-object
		 (vl-remove-if
		   'listp
		   (mapcar 'cadr (ssnamex (ssget '((0 . "*POLYLINE")))))
		   ) ;_ end of vl-remove-if
		 ) ;_ end of mapcar
	) ;_ end of setq
  (foreach item	selset
    (vla-explode item)
    (vla-erase item)
    (princ (strcat "\nОбработана полилиния : "
		   (rtos counter 2)
		   " из "
		   (rtos (length selset) 2)
		   ) ;_ end of strcat
	   ) ;_ end of princ
    (setq counter (1+ counter))
    ) ;_ end of foreach
  (loc:layer_status_restore)
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

AY · 11.08.2006, 12:04

Цитата:

Проблема в следующем: имеется 13000 трехмерных полилиний.
Необходимо их взорвать.

Выходит, что полилинии не трехмерные?

Лентяй · 11.08.2006, 13:03

Послушайте, коллеги, у вас же человек русским по белому просит ActiveX! Что же вы ему опять ssget всучить пытаетесь? Несолидно-с!

Вот, держите, чистый ActiveX код с визуализацией. За что отдельное спасибо Н.Н Полищуку, ну, мне, любимому, - тоже.

Код:

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

(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 . 1)) '(0 70)) 
    (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 1)) (list "Polyline" 8))))
  (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));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.0%")
    (set_tile "res" (strcat "Всего взорвано " (itoa m) " полилиний")));if
  (gc)
);expl

А вот и DCL, чтобы было красиво:

Код:

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

// Cоздано © А.Д. Шейнкман a.k.a. Лентяй
//на основе Приложения 3\progress.dcl
// © Н.Н.Полещук, 2006 г.
// В книге: Н.Н.Полещук, П.В.Лоскутов
//"AutoLISP и Visual LISP в среде AutoCAD"
// (издательство "БХВ-Петербург", 2006)
//
progress: dialog{label="Прогресс";
:text{alignment=centered;
      key="cnt1";}
:text{alignment=centered;
      key="cnt2";}
:text{alignment=centered;
      key="ttl";}
:row{
  :image{width=50;height=1.5;key="img";}
  :text{label="0%    ";key="cif";}
}//row
:text{alignment=centered;
      label="Результат: ";
      key="res";}
:row{fixed_width=true;alignment=centered;
  :button{label="Взорвать";key="start";}
  :ok_button{label="Выход/Отмена";is_cancel=true;}
}//row
}

Кочетков Андрей · 11.08.2006, 13:10

Да вроде трехмерные...
[ATTACH]1155287411.jpg[/ATTACH]
Да ладно, Андрюх, забей. Спасибо, что не оставил без внимания

>>Kpblc
То, что доктор прописал! Спасибо громадное!

Кулик Алексей aka kpblc · 11.08.2006, 15:41

[b]> Лентяй[b/] : прошу прощения, я уже капитально дунувши (все же отпуск на носу), но МНЕ УДОБНО через (ssget). Кроме того, у Полещука опять же сказано, что activex выбор надо потом очищать для операций с его элементами...

Кочетков Андрей · 11.08.2006, 17:33

>>Лентяй
Запуская. Говорю "ВЫ" (с уважением).
Выбираю объекты. Пишет "0 found".
Я там строчку увидел "(vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 1)) (list "Polyline" 8))))".
Тут вроде разговор не про 3Д-полилинию?
А выбираю именно их.

Лентяй · 11.08.2006, 20:32

Цитата:

Сообщение от kpblc

[b]> Лентяй[b/] : прошу прощения, я уже капитально дунувши (все же отпуск на носу), но МНЕ УДОБНО через (ssget). Кроме того, у Полещука опять же сказано, что activex выбор надо потом очищать для операций с его элементами...

Избавляться нужно от вредных-то привычек

! Равно, впрочем, как и от пережитков проклятого прошлого. А насчет очистки, так ass надо очищать не пред обработкой, а перед новым заполнением. У меня на то особое заклинание есть. В начале каждой программы следет ставить

Код:

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

(if (> (vla-get-count ass) 0) (vla-clear ass))

И будет вам щастя

Лентяй · 11.08.2006, 20:39

Цитата:

Сообщение от Кочетков Андрей

>>Лентяй
Запуская. Говорю "ВЫ" (с уважением).
Выбираю объекты. Пишет "0 found".
Я там строчку увидел "(vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 1)) (list "Polyline" 8))))".
Тут вроде разговор не про 3Д-полилинию?
А выбираю именно их.

А в чем собс-но проблема? Тип примитива (код 0) - "Polyline", а значение кода 70 равное 8 указывает на 3D (8 = This is a 3D polyline). Так что все в порядке. Если же вы сомневаетесь, киньте файл - посмотрю.

Кочетков Андрей · 12.08.2006, 19:34

>>Лентяй
В понедельник скину. А сейчас у меня День Строителя :wink:

Лентяй · 12.08.2006, 23:36

Цитата:

Сообщение от Кочетков Андрей

>>Лентяй
В понедельник скину. А сейчас у меня День Строителя :wink:

А у меня в понедельник - день варенья, [sm166] А во вторник - день поправки здоровья. [sm1303] Так что раньше четверга по Москве - не недейтесь. [sm2200]

Кочетков Андрей · 13.08.2006, 11:09

Поздравляю! Желаю финансовой сытости и душевного здоровья

Лентяй · 13.08.2006, 12:23

Спасибо! За такие слова - посмотрю во вторник не взирая на главоболие с похмелия.

AY · 14.08.2006, 14:39

Цитата:

А в чем собс-но проблема? Тип примитива (код 0) - "Polyline", а значение кода 70 равное 8 указывает на 3D (8 = This is a 3D polyline). Так что все в порядке. Если же вы сомневаетесь, киньте файл - посмотрю.

Собственно и я о том же. Если фильтр ((0 . "POLYLINE") (70 . 8)) примененный и в варианте Лентяя и в моем ничего не находит то следует задуматься о соответствии этих полилиний тому, что пердписывает спецификация DXF для кода 70, а именно:

Polyline flag (bit-coded; default = 0):
1 = This is a closed polyline (or a polygon mesh closed in the M direction)
2 = Curve-fit vertices have been added
4 = Spline-fit vertices have been added
8 = This is a 3D polyline
16 = This is a 3D polygon mesh
32 = The polygon mesh is closed in the N direction
64 = The polyline is a polyface mesh
128 = The linetype pattern is generated continuously around the vertices of this polyline

В связи с выше сказанным можно придраться к фильтру ((0 . "*POLYLINE")) уважаемого kpblс'a поскольку в него (фильтр) попадут кроме 3D полилиний все, что перечилсено в списке выше и, кроме того, LWPOLYLINE и, что теоретически возможно, пользовательские объекты названия которых оканчиваются соответственно. Что, разумеется, нежелательно.

Поэтому для прояснения ситуации следует опубликовать распечатку dxf для какой-нибудь одной полилинии получаемую выражением (entget (car (entsel)) '("*")). Или как предлагал Лентяй опубликовать файл хотябы с одной из полилиний.

Кочетков Андрей · 15.08.2006, 09:34

Выкладываю файл
[ATTACH]1155620047.dwg[/ATTACH]

10.08.2006, 17:57		#1
Нужен Лисп: программный EXPLODE выделенных объектов Кочетков Андрей Java/Kotlin backend Регистрация: 03.02.2006 Сообщений: 5,737 Господа программисты! Опять нужна ваша помощь. Проблема в следующем: имеется 13000 трехмерных полилиний. Необходимо их взорвать. Если их все выделить и дать команду EXPLODE то Акад виснет наглухо. Если делать это по частям, то получается очень долго. Поэтому у меня просьба написать следующую программу: выделяем объекты, запускаем программу Программа применяет команду EXPLODE (желательно через activex для увеличения скорости) к каждому объекту в наборе. При этом в командной строке выводится надпись: Всего объектов: УУУ. Осталось: ХХХ. Эта надпись обновляется после взрывания каждого примитива (как в Тулпаке). Мне это нужно для оценки времени работы.
Просмотров: 7873

Опции темы	Поиск в этой теме
	Поиск в этой теме: Расширенный поиск