Нужен Лисп: программный EXPLODE выделенных объектов
| Правила | Регистрация | Пользователи | Сообщения за день |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Нужен Лисп: программный EXPLODE выделенных объектов

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

Ответ
Поиск в этой теме
Непрочитано 10.08.2006, 17:57 #1
Нужен Лисп: программный EXPLODE выделенных объектов
Кочетков Андрей
 
Java/Kotlin/Go
 
Регистрация: 03.02.2006
Сообщений: 5,786

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

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

Мне это нужно для оценки времени работы.
Просмотров: 8208
 
Непрочитано 10.08.2006, 19:23
#2
AY

webcad.pro
 
Регистрация: 06.01.2005
Московская обл.
Сообщений: 501


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

Код:
[Выделить все]
(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
AY вне форума  
 
Автор темы   Непрочитано 11.08.2006, 09:37
#3
Кочетков Андрей

Java/Kotlin/Go
 
Регистрация: 03.02.2006
Сообщений: 5,786


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

Код:
[Выделить все]
Command: explode-3dpolyline
bad argument type: lselsetp nil
Ошибка возникате в лямбда-функции.
Может я что не так делаю?
Кочетков Андрей вне форума  
 
Непрочитано 11.08.2006, 09:53
#4
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,411


Попробуй это:
Код:
[Выделить все]
(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
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 11.08.2006, 09:54
#5
AY

webcad.pro
 
Регистрация: 06.01.2005
Московская обл.
Сообщений: 501


Надо полагать в чертеже нет полилиний. Исправлю. Попробуй в чертеже с полилиниями.
AY вне форума  
 
Автор темы   Непрочитано 11.08.2006, 11:29
#6
Кочетков Андрей

Java/Kotlin/Go
 
Регистрация: 03.02.2006
Сообщений: 5,786


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

>>Krblc
Работет!
А можно изменить программу так, чтобы она применялась не ко всем объектам чертежа, а только к выделенным (чтобы перед запуском был диалог на выбор объектов)?
Кочетков Андрей вне форума  
 
Непрочитано 11.08.2006, 11:32
#7
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,411


всего 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
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 11.08.2006, 12:04
#8
AY

webcad.pro
 
Регистрация: 06.01.2005
Московская обл.
Сообщений: 501


Цитата:
Проблема в следующем: имеется 13000 трехмерных полилиний.
Необходимо их взорвать.
Выходит, что полилинии не трехмерные?
AY вне форума  
 
Непрочитано 11.08.2006, 13:03
#9
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Послушайте, коллеги, у вас же человек русским по белому просит 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
#10
Кочетков Андрей

Java/Kotlin/Go
 
Регистрация: 03.02.2006
Сообщений: 5,786


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


>>Kpblc
То, что доктор прописал! Спасибо громадное!
Кочетков Андрей вне форума  
 
Непрочитано 11.08.2006, 15:41
#11
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,411


[b]> Лентяй[b/] : прошу прощения, я уже капитально дунувши (все же отпуск на носу), но МНЕ УДОБНО через (ssget). Кроме того, у Полещука опять же сказано, что activex выбор надо потом очищать для операций с его элементами...
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 11.08.2006, 17:33
#12
Кочетков Андрей

Java/Kotlin/Go
 
Регистрация: 03.02.2006
Сообщений: 5,786


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

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Сообщение от kpblc
[b]> Лентяй[b/] : прошу прощения, я уже капитально дунувши (все же отпуск на носу), но МНЕ УДОБНО через (ssget). Кроме того, у Полещука опять же сказано, что activex выбор надо потом очищать для операций с его элементами...
Избавляться нужно от вредных-то привычек ! Равно, впрочем, как и от пережитков проклятого прошлого. А насчет очистки, так ass надо очищать не пред обработкой, а перед новым заполнением. У меня на то особое заклинание есть. В начале каждой программы следет ставить
Код:
[Выделить все]
(if (> (vla-get-count ass) 0) (vla-clear ass))
И будет вам щастя
Лентяй вне форума  
 
Непрочитано 11.08.2006, 20:39
#14
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Сообщение от Кочетков Андрей
>>Лентяй
Запуская. Говорю "ВЫ" (с уважением).
Выбираю объекты. Пишет "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
#15
Кочетков Андрей

Java/Kotlin/Go
 
Регистрация: 03.02.2006
Сообщений: 5,786


>>Лентяй
В понедельник скину. А сейчас у меня День Строителя :wink:
Кочетков Андрей вне форума  
 
Непрочитано 12.08.2006, 23:36
#16
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Сообщение от Кочетков Андрей
>>Лентяй
В понедельник скину. А сейчас у меня День Строителя :wink:
А у меня в понедельник - день варенья, [sm166] А во вторник - день поправки здоровья. [sm1303] Так что раньше четверга по Москве - не недейтесь. [sm2200]
Лентяй вне форума  
 
Автор темы   Непрочитано 13.08.2006, 11:09
#17
Кочетков Андрей

Java/Kotlin/Go
 
Регистрация: 03.02.2006
Сообщений: 5,786


Поздравляю! Желаю финансовой сытости и душевного здоровья
Кочетков Андрей вне форума  
 
Непрочитано 13.08.2006, 12:23
#18
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Спасибо! За такие слова - посмотрю во вторник не взирая на главоболие с похмелия.
Лентяй вне форума  
 
Непрочитано 14.08.2006, 14:39
#19
AY

webcad.pro
 
Регистрация: 06.01.2005
Московская обл.
Сообщений: 501


Цитата:
А в чем собс-но проблема? Тип примитива (код 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)) '("*")). Или как предлагал Лентяй опубликовать файл хотябы с одной из полилиний.
AY вне форума  
 
Автор темы   Непрочитано 15.08.2006, 09:34
#20
Кочетков Андрей

Java/Kotlin/Go
 
Регистрация: 03.02.2006
Сообщений: 5,786


Выкладываю файл
[ATTACH]1155620047.dwg[/ATTACH]
Кочетков Андрей вне форума  
 
Непрочитано 15.08.2006, 10:38
#21
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Послушайте, Кочетков Андрей, вы - мерзкий провокатор! Вы думали, подсунете мне 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
Лентяй вне форума  
 
Непрочитано 15.08.2006, 11:58
#22
AY

webcad.pro
 
Регистрация: 06.01.2005
Московская обл.
Сообщений: 501


И все-таки сглаженные 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. Кстати куда это крыс пропал?
AY вне форума  
 
Автор темы   Непрочитано 15.08.2006, 13:50
#23
Кочетков Андрей

Java/Kotlin/Go
 
Регистрация: 03.02.2006
Сообщений: 5,786


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

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

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

Даже не знаю какой вывод сделать. Переписать что ли все команды Автокада
Кочетков Андрей вне форума  
 
Непрочитано 06.08.2009, 11:08
#24
kakt00z

инженер-проектировщик КИПиА
 
Регистрация: 30.08.2008
Минск
Сообщений: 159


Приветствую!
подскажите пожалуйста, можно ли в аргумент _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, и т.д. но не получается
может кто-нибудь сможет обьяснить что ему надо?
kakt00z вне форума  
 
Непрочитано 06.08.2009, 11:31
#25
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Код:
[Выделить все]
 
(sssetfirst nil (ssget "_X" '((0 . "MTEXT"))))
(command "_explode")
CB вне форума  
 
Непрочитано 06.08.2009, 12:35
#26
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,996


Уточнение к #25 PICKFIRST должно быть равно 1
Как программно "взорвать" блоки?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Нужен Лисп: программный EXPLODE выделенных объектов