[DmitriM]

Добрый день,
Аutolisp пользуюсь недавно, в существующих темах форума моего вопроса, вроде бы, нет. Если есть - просьба дать ссылку.

Исх.даннные: Имеется вставленный блок, состоящий из набора окружностей.
Требуется: Перебрать все входящие окружности, получить их центры по DBX коду 10, и записать результат в список/переменную/набор/...?

[Дима_]

Тебе центры нужны относительно блока (они - если блок не динамический не меняються) или в модели (они в общем-то тоже не меняяються относительно точки вставки блока надо только учесть поворот (dxf 50) и вектор (dxf 210)). То есть последовательность такая - берешь имя вхождения блока, смотришь его описание ишещь там нужные круги, преобразуешь координату. ключевые слова (хватит и автокадовской справки): tblsearch, trans.

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

Возвращает координаты центров окружностей блока относительно его базовой точки:

Код:

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

(vl-load-com)

(defun test (/ blk_ent)
  (if (and (= (type (setq blk_ent (vl-catch-all-apply
                                    (function
                                      (lambda ()
                                        (car (entsel "\nУкажите блок <Отмена> : "))
                                        ) ;_ end of lambda
                                      ) ;_ end of function
                                    ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'ename
              ) ;_ end of =
           (= (cdr (assoc 0 (entget blk_ent))) "INSERT")
           ) ;_ end of and
    (setq res (mapcar (function (lambda (x) (vlax-safearray->list (vlax-variant-value (vla-get-center x)))))
                      (vl-remove-if-not
                        (function
                          (lambda (a)
                            (wcmatch (strcase (vla-get-objectname a)) "*CIRCLE*")
                            ) ;_ end of lambda
                          ) ;_ end of function
                        ((lambda (/ lst)
                           (vlax-for item (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
                                                    (cdr (assoc 2 (entget blk_ent)))
                                                    ) ;_ end of vla-item
                             (setq lst (cons item lst))
                             ) ;_ end of vlax-for
                           (reverse lst)
                           ) ;_ end of lambda
                         )
                        ) ;_ end of vl-remove-if-not
                      ) ;_ end of mapcar
          ) ;_ end of setq
    ) ;_ end of if
  res
  ) ;_ end of defun

[DmitriM]

Спасибо за ответ насчет извлечения центров. Хотел, правда, избежать Active-x...
Хочу еще понять, во что лучше записать этот набор координат, чтобы обработать список - на его основе построить окужности большего диаметра.
Понимаю, что вопрос не так уж интересен, но для меня он важен. (есть книга Полищука по Лиспу, но там это не освещено).

[CB]

на его основе построить окужности большего диаметра

Где построить окружность - в блоке или просто?
Освети вопрос более расширенно...

[DmitriM]

Сообщение от CB Где построить окружность - в блоке или просто? Освети вопрос более расширенно...

На открытом файле чертежа вставлен блок, состоящий из окужностей радиуса 1.
После извлечения центров требуется запустить цикл, который для каждой пары координат центров (X,Y) построит окружность, радиусом 2.

[CB]

Т.е. я правильно понял - новые окружности нужно строить не в блоке, а в пространстве модели?

[DmitriM]

Сообщение от CB Т.е. я правильно понял - новые окружности нужно строить не в блоке, а в пространстве модели?

Да, именно так. Кстати, блок предполагается вставлять из другого, уже открытого чертежа в текущий, и потом к нему пририсовывать новые окружности в пространстве чертежа. Хотя я еще не пробовал, видит ли команда ._INSERT блоки всех открытых чертежей, или только текущего.

[CB]

Сначала по названию темы:
Как осуществить перебор примитивов блока на Лиспе
Пара вариантов без Active-x

Код:

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

(defun iter-ent-block (name / lst)
  (while name
    (setq lst
       (append
         lst
         (list
           (cons (cdr (assoc '0 (entget name)))
             name
           ) ;_ end of cons
         ) ;_ end of list
       ) ;_ end of append
    ) ;_ end of setq
    (setq name (entnext name))
  ) ;_ end of while
  lst
) ;_ end of defun
;;;вызов (iter-ent-block (cdr (assoc '-2 (tblsearch "block" "имя блока"))))
 
(defun rec-ent-block (name)
  (if name
    (append
      (list
    (cons (cdr (assoc '0 (entget name))) name)
      ) ;_ end of list
      (rec-ent-block (setq name (entnext name)))
    ) ;_ end of append
  ) ;_ end of if
) ;_ end of defun
;;;вызов (rec-ent-block (cdr (assoc '-2 (tblsearch "block" "имя блока"))))

После извлечения центров требуется запустить цикл, который для каждой пары координат центров (X,Y) построит окружность, радиусом 2.

Без проверок на ошибки...(используется rec-ent-block)

Код:

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

(defun test (/ d block_dxf block_name block_ins lst_obj)
  (setq d (getreal "\nУкажите диаметр окружности: "))
  (setq block_dxf  (entget (car (entsel "\nУкажите блок: ")))
        block_name (cdr (assoc '2 block_dxf))
        block_ins  (cdr (assoc '10 block_dxf))
  ) ;_ end of setq
  (setq lst_obj
         (vl-remove-if-not
           '(lambda (x) (= (car x) "CIRCLE"))
           (rec-ent-block
             (cdr (assoc '-2 (tblsearch "block" block_name))
             ) ;_ end of cdr
           ) ;_ end of rec-ent-block
         ) ;_ end of vl-remove-if-not
  ) ;_ end of setq
  (if lst_obj
    (mapcar
      '(lambda (x)
         (entmakex
           (list
             '(0 . "CIRCLE")
             (cons
               10
               (mapcar '+
                       block_ins
                       (cdr (assoc 10 (entget x)))
               ) ;_ end of mapcar
             ) ;_ end of cons
             (cons 40 d)
           ) ;_ end of list
         ) ;_ end of entmakex
       ) ;_ end of lambda
      (mapcar 'cdr lst_obj)
    ) ;_ end of mapcar
  ) ;_ end of if
  (princ)
) ;_ end of defun

[DmitriM]

Сообщение от CB Сначала по названию темы: Как осуществить перебор примитивов блока на Лиспе Пара вариантов без Active-x Код: [Выделить все] (defun iter-ent-block (name / lst) (while name (setq lst (append lst ...

Даже не ожидал такой поддержки форума. Большое спасибо, буду разбирать теперь эти функции, ну и доделывать под себя, если придется.