[BulKonst]

Доброго времени суток. Подскажите пожалуйста как установить ПСК относительно области (Region).
Есть набор Region-ов выбираю максимальный из них (по площади) и по нему нужно установить ПСК, т.е.:
(command "_ucs" "_ob" obj_max) – не работает (ошибка: функция прервана)
Но (command "_ucs" "_ob") – работает, предлагает выбрать объект, значит дело в obj_max?
К примеру по аналогии:
(setq obj (car (entsel)))
(command "_explode" obj) – работает без проблем.

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

obj_max чему равен? Полный код, касающийся этого куска, покажи. ПО идее должно сработать нечто типа

Код:

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

(defun tt (/ ss ent)

  (if (setq selset (ssget '((0 . "REGION"))))
    (progn
      (setq
        ent (car
              (vl-sort
                ((lambda (/ item tab)
                   (repeat (setq tab  nil
                                 item (sslength selset)
                                 ) ;_ end setq
                     (setq tab (cons (ssname selset (setq item (1- item))) tab))
                     ) ;_ end of repeat
                   ) ;_ end of lambda
                 )
                (function (lambda (a b)
                            (> (vla-get-area (vlax-ename->vla-object a)) (vla-get-area (vlax-ename->vla-object b)))
                            ) ;_ end of lambda
                          ) ;_ end of function
                ) ;_ end of vl-sort
              ) ;_ end of car
        ) ;_ end of setq
      (command "_.ucs" "_ob" ent)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

[BulKonst]

Кулик Алексей aka kpblc, спасибо большое за полный текст, но вопросы с сортировкой и т.п. решены. Насущный вопрос перенос ПСК. Вот текст тестовой программы:

Код:

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

 (setq obj (car (entsel)))
(princ obj)
(command "_.ucs" "_ob" obj)

В консоли:
_$
<Имя объекта: 7ffff705a10>
; ошибка: Функция прервана.
_$

С Вашей функцией тоже самое. На чертеже AutoCad только области (Region) получаемые с помощью _explode из 3dsolid (параллелепипеда).

[Do$]

Может снова старые грабли передачи объекта в команду?

Код:

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

 (setq obj (car (entsel)))
(princ obj)
(command "_.ucs" "_ob" obj)

[BulKonst]

Do$, все равно не работает.

[Do$]

М-да... Эта опция не "кушает" ни ENAME, ни список получаемый ENTSEl, ни набор:

Код:

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

Возобновляется команда ПСК.
Начало ПСК или [Грань/именоваННая/ОБъект/преДыдущая/Вид/Мир/X/Y/Z/ZОсь] <Мир>: _obj
Выберите объект для задания ПСК: (entsel)
Выберите объект: (<Имя объекта: 7ffffb05d10> (96.8228 5.0919 0.0))
Этот объект не определяет систему координат
Команда: ПСК
Текущая ПСК:  *БЕЗ ИМЕНИ*
Начало ПСК или [Грань/именоваННая/ОБъект/преДыдущая/Вид/Мир/X/Y/Z/ZОсь] <Мир>: ОБ
Выберите объект для задания ПСК: (nentsel)
Выберите объект: (<Имя объекта: 7ffffb05d10> (113.704 7.49508 0.0))
Этот объект не определяет систему координат
Команда: ПСК
Текущая ПСК:  *БЕЗ ИМЕНИ*
Начало ПСК или [Грань/именоваННая/ОБъект/преДыдущая/Вид/Мир/X/Y/Z/ZОсь] <Мир>: ОБ
Выберите объект для задания ПСК: (car (entsel))
Выберите объект: <Имя объекта: 7ffffb05d10>
Этот объект не определяет систему координат
Команда: ПСК
Текущая ПСК:  *БЕЗ ИМЕНИ*
Начало ПСК или [Грань/именоваННая/ОБъект/преДыдущая/Вид/Мир/X/Y/Z/ZОсь] <Мир>: ОБ
Выберите объект для задания ПСК: (ssadd (car (entsel)))
Выберите объект: <Selection set: 10e>
Этот объект не определяет систему координат

Я не знаю, как помочь, если использовать командный метод.
Хех, нашел.

Код:

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

Команда: ПСК
Текущая ПСК:  *БЕЗ ИМЕНИ*
Начало ПСК или [Грань/именоваННая/ОБъект/преДыдущая/Вид/Мир/X/Y/Z/ZОсь] <Мир>: ОБ
Выберите объект для задания ПСК: (cadr (entsel))
Выберите объект: (95.1347 4.85158 0.0)

[BulKonst]

Do$, работает но не подходит т.к. имя примитива нужно брать из набора:

Код:

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

(setq nab_face (ssget "_X" '((0 . "Region"))))
(setq obj_face (ssname nab_face 0))

Возвращаемое значение (obj_face) только имя примитива. К тому же в одной точке может быть несколько Region-ов и выбираться будет тот который на переднем плане.
Нашел на форуме установку ПСК по 3-м точкам "Не могу совладать с (command "_UCS")" (command "_.ucs" "_3p" pt0 pt1 pt2), попробую пока её:
....
(command "_explode" obj_face)
(...выбираем "line"...)
(...анализируем точки...)
(...запоминаем pt0 pt1 pt2...)
(command "_u") ;отменяем _explode
(command "_.ucs" "_3p" pt0 pt1 pt2)
....

[Do$]

Жесть. Взрываете объект, чтобы извлечь его точки? Гораздо проще (entget obj_face) и вытащить нужные группы.

[BulKonst]

Сообщение от Do$ Жесть. Взрываете объект, чтобы извлечь его точки? Гораздо проще (entget obj_face) и вытащить нужные группы.

Полностью с Вами согласен, жесть, но есть несколько нюансов:
1. Уровень программирования - практически никакой
2. (entget obj_face) - где obj_face это Region выводит нечто неописуемое для моего понимания.
Если у Вас есть решение как из obj_face вытащить вершины, буду Вам очень признателен.

[Do$]

Одно из главных правил программирования - давайте интуитивно понятные имена переменным
Я рассудил, что если названо obj_face, то работаете с объектом 3DFACE. Из него точки элементарно извлекаются. С REGION не работал никогда, возможно, что там не так все просто. Чертеж с нужным объектом выложите, гляну.
Я бы дал переменной имя ent_region, если исходить из такой нотации. ent - общепринятое имя переменной для хранения ename (entity name). А имя obj обычно используется для хранения значений типа vla-object.
Зачем это надо? Чтобы самому потом спустя некоторое время понимать что к чему.

[BulKonst]

Do$, выладываю dwg с описанием
Программа для анализа деталей из листового материала из 3d объекта.
Должна выводить приблизительно: ДСП-16 1000х500 – 2шт <<45<70
ДСП-16 1000х500 – габариты, <<45 – два угла 45гр., <70 – один угол 70гр. (запилы торца)

….
(command "_explode" ent_3dsolid) (получил 6 плоскостей максимальная из них - есть площадь детали)

....
(command "_explode" ent_region_max)
(... выбираем "line"... анализируем точки запоминаем pt0 pt1 pt2...)
(command "_u") ; отменяем _explode
(command "_.ucs" "_3p" pt0 pt1 pt2); переносим СК параллельно ent_region_max
....
(command "_explode" ent_region_n) (где n от 0 до 6 то есть взрываем по очереди все плоскости)
(... выбираем "line"....анализируем точки...)
(command "_u") ; отменяем _explode для ent_region_n
....

(command "_u") ; отменяем _.ucs
(command "_u") ; отменяем _explode для ent_3dsolid
....

В итоге получены вершины 6 плоскостей параллелепипеда – по ним составляю уравнения плоскостей, вычисляю углы и т.д.

В общем все работает, но наткнулся на один нюанс. Если два параллельных ребра наклонены в одну сторону, то габарит детали будет больше чем площадь ent_region_max. Для решения этой проблемы решил перенести СК параллельно ent_region_max, габариты детали будут X_max–X_min и Y_max–Y_min (max и min вычисляем из всех 8 вершин параллелепипеда).

[Do$]

Да, неблагодарное это занятие - работать с телами в голом акаде. В entget списке есть полное описание их геометрии и где-то тут на форуме был документ про этот формат, но разобраться в этом немногие смогут. Так что, взрывать, пожалуй, проще.
Вот пример того, как можно более грамотно взрывать объекты типа REGION:

Код:

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

;; Подгружаем ActiveX расширение для AutoLISP
;; Это достаточно делать один раз для текущего сеанса в текущем чертеже, но от повторной загрузки проблем не будет.
(vl-load-com)
;; Выбираем объект
(setq obj (vlax-ename->vla-object (car (entsel "\nВыберите область (объект типа REGION): "))))
;; Взрываем объект. Осколки сохраняем в вариант. Сам объект при этом не удаляется.
(setq variant_exploded_obj (vla-explode obj))
;; Преобразуем вариант в безопасный массив.
(setq safearray_exploded_obj (vlax-variant-value variant_exploded_obj))
;; Преобразуем безпасный массив в список vla-объектов, появившихся после взрыва
(setq list_exploded_obj (vlax-safearray->list safearray_exploded_obj))
;; Преобразуем список vla-объектов в список ename
(setq list_exploded_ent
       (mapcar 'vlax-vla-object->ename list_exploded_obj)
)

;; Получили список ename, тут с ними делаем все что угодно - извлекаем информацию и т.п.
;; Можно было бы работать и с vla-объектами, но я думаю, что это темный лес пока что

;; Для примера выведем информацию о них:
(foreach
	  ent
	     list_exploded_ent
  (setq ent_getlist (entget ent))
  (if (= (setq ent_type_name (cdr (assoc 0 ent_getlist))) "LINE")
    (progn
      (setq pt_start (cdr (assoc 10 ent_getlist))
	    pt_end (cdr (assoc 11 ent_getlist)))
      (princ (strcat "\nОбнаружен отрезок. Начало: "
		     (rtos (car pt_start) 2 4)
		     ", "
		     (rtos (cadr pt_start) 2 4)
		     ", "
		     (rtos (caddr pt_start) 2 4)
		     ". Конец: "
		     (rtos (car pt_end) 2 4)
		     ", "
		     (rtos (cadr pt_end) 2 4)
		     ", "
		     (rtos (caddr pt_end) 2 4)
	     )
      )
    )
    (princ (strcat "\nОбнаружен объект типа " ent_type_name))
  )
)

;; Удаляем объекты, чтобы они не замусоривали чертеж
(mapcar 'entdel list_exploded_ent)

К сожалению, с объектом 3DSOLID такой фокус не пройдет.

[BulKonst]

Do$, нашел функцию вытаскивания вершин и длин граней Region без взрыва:

Код:

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

 (setq edat (entget (car (entsel))))
(setq n (1- (length edat)))
(setq dat '())
(while (>= n 0)
  (if (= 1 (car (nth n edat)))
    (setq dat (cons (vl-string->list (cdr (nth n edat))) dat))
  ) ;_  if
  (setq n (1- n))
) ;_  while
(setq n (1- (length dat)))
(setq points '())
(setq edge '())
(while (>= n 0)
  (setq d (nth n (reverse dat)))
  (setq p '())
  (foreach x (reverse d) (setq p (cons (boole 6 x 95) p))) ; декодирование строки
  (setq str (vl-list->string p))
  ;; разбивка строкИ на отдельные стрОки
  (setq poss 0) ; начальная позиция
  (setq strl '()) ; список строк
  (while (setq pose (vl-string-search "\177" str poss))
    (setq strpart (substr str (1+ poss) (- pose poss)))
    (setq strl (cons (if (distof strpart)
                       (distof strpart)
                       strpart
                     ) ;_  if
                     strl
               ) ;_  cons
    ) ;_  setq
    (setq poss (1+ pose))
  )
  (setq strl (reverse strl)) ; список строк готов
;;  (princ "\n")
;;  (princ strl)
  (cond  ;; сортировка в списки-группы
    ((= (car strl) "point") (setq points (cons (vl-remove "$-1" strl) points)))
    ((= (car strl) "edge") (setq edge (cons (vl-remove "$-1" strl) edge)))
  ) ;_  cond
  (setq n (1- n))
) ;_  while
(princ points)
(princ "\n")
(princ edge)
(princ "\n")

Выводит:

Код:

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

((point -1.0 20.0 46.0 50.0) (point -1.0 520.0 46.0 50.0) (point -1.0 520.0 46.0 1050.0) (point -1.0 20.0 46.0 1050.0))
((edge $34 -1.0 $27 0.0 $30 500.0 $18 $35 forward  unknown) (edge $29 -1.0 $30 0.0 $22 1000.0 $16 $31 forward  unknown) (edge $26 -1.0 $27 0.0 $23 1000.0 $15 $28 forward  unknown) (edge $21 -1.0 $22 -500.0 $23 0.0 $14 $24 forward  unknown))

Изначально функция была для 3dsolid (да и сейчас работает для 3dsolid), в strl есть еще много других значений. Но вот только совсем не понятно как она работает.
В итоге получается для работы программы нужно:
….
(command "_explode" ent_3dsolid) (получил 6 плоскостей максимальная из них - есть площадь детали)
....

(определяем ent_region_max)
(... анализируем ent_region_max запоминаем pt0 pt1 pt2...)
(command "_.ucs" "_3p" pt0 pt1 pt2); переносим СК параллельно ent_region_max
....
(... анализируем ent_region_n...) (где n от 0 до 6 то есть взрываем по очереди все плоскости)

....
(command "_u") ; отменяем _.ucs
(command "_u") ; отменяем _explode для ent_3dsolid
....
Предлагаю разобрать данную функцию анализа Region и 3dsolid на отдельной ветке форума, а то очень отдалились о темы.

[BulKonst]

Готовая фукция переноса СК относительно Region:

Код:

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

 ; Для примитивов Region (область)
; Тестировалась для Region-ов в виде прямоугольников, ромбов, трапеций и т.п. Region-ов из 4-х прямых линий
; В списке points - координаты вершин
; В списке edge_sort - длины граней без повторяющихся значений 
(setq edat (entget (car (entsel))))
(setq n (1- (length edat)))
(setq dat '())
(while (>= n 0)
  (if (= 1 (car (nth n edat)))
    (setq dat (cons (vl-string->list (cdr (nth n edat))) dat))
  ) ;_  if
  (setq n (1- n))
) ;_  while
(setq n (1- (length dat)))
(setq points '())
(setq edge '())
(while (>= n 0)
  (setq d (nth n (reverse dat)))
  (setq p '())
  (foreach x (reverse d) (setq p (cons (boole 6 x 95) p))) ; декодирование строки
  (setq str (vl-list->string p))
  ;; разбивка строкИ на отдельные стрОки
  (setq poss 0) ; начальная позиция
  (setq strl '()) ; список строк
  (while (setq pose (vl-string-search "\177" str poss))
    (setq strpart (substr str (1+ poss) (- pose poss)))
    (setq strl (cons (if (distof strpart)
                       (distof strpart)
                       strpart
                     ) ;_  if
                     strl
               ) ;_  cons
    ) ;_  setq
    (setq poss (1+ pose))
  )
  (setq strl (reverse strl)) ; список строк готов
  (cond  ;; сортировка в списки-группы
    ((= (car strl) "point") (setq points (cons (list (nth 4 strl) (nth 5 strl) (nth 6 strl)) points)))
    ((= (car strl) "edge") (setq edge (cons (abs (nth 5 strl)) edge)) (setq edge (cons (abs (nth 7 strl)) edge)))
  ) ;_  cond
  (setq n (1- n))
) ;_  while
; исключение из списка повторяющихся элементов
(setq edge_sort '())
(repeat (1- (+ (length edge) 1))
  .
  (
  (if (and (= (member (car edge) edge_sort) nil) (/= (car edge) 0.0)) (setq edge_sort (cons (car edge) edge_sort)))
  (setq edge (cdr edge))
  )
)

(command "_.ucs" "_w")
(command "_.ucs" "_3p" (nth 0 points) (nth 1 points) (nth 2 points))

(princ points)
(princ "\n")
(princ edge_sort)
(princ "\n")