[DY]

Код:

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

 
(setq B (vlax-ename->vla-object (car(entsel))))
(vla-GetBoundingBox B 'minp 'maxp)
(print (vlax-safearray->list minp))

Почему выдает результат как
(17.287 164.327 -1.0e-008) (17.287 164.327 -1.0e-008)

вместо
(17.287 164.327 -1.0e-008)

Так и должно быть???

И еще один вопрос:
vla-GetBoundingBox для одного объекта
а есть ли аналог vla-GetBoundingBox для списка объектов?

Спасибо.

[VVA]

1.Так лучше?

Код:

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

(setq B (vlax-ename->vla-object (car(entsel))))
(vla-GetBoundingBox B 'minp 'maxp)
(print (vlax-safearray->list minp))(princ)

Найди 1 отличие.
2. На почившем в бозе autocad.ru Евгений Елпанов выкладывал такую ф-цию.

Код:

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

;|
;**************** lst-getboundingbox.lsp *************
;   Функция    определения габаритного контейнера
;   для списка VLA объектов
;   Автор  Евгений Елпанов.
;*****************************************************
;   Аргумент lst - список VLA объектов
;   пример получения списка с использованием (ssget) :
(if (setq sset (ssget))
 (setq lst
       (mapcar
        (function vlax-ename->vla-object)
        (vl-remove-if
         (function listp)
         (mapcar (function cadr) (ssnamex sset))
        ) ;_ vl-remove-if
       ) ;_  mapcar
 ) ;_  setq
)
;   Пример вызова:
 (lst-getboundingbox lst)
;   Возвращает список из двух 3d точек
;   '((левая нижняя) (правая верхняя))
|;
;|=============================================================================
=============================================================================|;
(defun lst-getboundingbox (lst / maxp minp)
  (vl-load-com)
  (if (and lst (listp lst))
    (apply
      (function
 (lambda (a1 a2 a3 a4 a5 a6)
   (list
     (list
       (apply (function min) a1)
       (apply (function min) a2)
       (apply (function min) a3)
       ) ;_ end of list
     (list
       (apply (function max) a4)
       (apply (function max) a5)
       (apply (function max) a6)
       ) ;_ end of list
     ) ;_ end of list
   ) ;_ end of lambda
 ) ;_ end of function
      (apply
 (function mapcar)
 (cons
   'list
   (mapcar
     (function
       (lambda (x)
  (vla-getboundingbox x 'minp 'maxp)
  (append
    (vlax-safearray->list minp)
    (vlax-safearray->list maxp)
    ) ;_ end of append
  ) ;_ end of lambda
       ) ;_ end of function
     lst
     ) ;_ end of mapcar
   ) ;_ end of cons
 ) ;_ end of apply
      ) ;_ end of apply
    ) ;_ end of if
 
  ) ;_ end of defun

[DY]

Спасибо!

Хотя не могу "догнать" действие связки
(print (vlax-safearray->list minp))(princ)

Видимо вечер - устал...

[VVA]

Любая ф-ция автолиспа возвращает результат. Что-то типа зхо-вывода. А princ без аргументов печатает "пусто". Поэтому рекомендуется команды заканчивать (princ), чтобы не пугать пользователей, выполнивших команду чем-то типа

Выберите объект: #<VLA-OBJECT IAcadLine 13874804>

Т.е. (print (vlax-safearray->list minp)) печатает координаты и возвращает их же в качестве эхо-вывода. Вот и получается дубляж

[DY]

Да уж...
Это не паскаль и Дельфи. Что то туговато мне этот LISP дается - не всегда логику действий понимаю. Хотя надо признать, в чем-то он проще не куда.

[ShaggyDoc]

Сообщение от DY Да уж... Это не паскаль и Дельфи. Что то туговато мне этот LISP дается - не всегда логику действий понимаю. Хотя надо признать, в чем-то он проще не куда.

Да уж. Не Pascal. Это совершенно иная "религия" - функциональный язык. Но после понимания логики, а этого можно достичь и за час (как при обучении езде на велосипеде - никак не получалось, но вдруг поехал, и теперь уже на всю жизнь). Вот тогда можно использовать все преимущества LISP и удивляться, почему простые вещи в императивных языках приходится делать так сложно.

И в то же время не пытаться сделать на LISP то, что гораздо удобнее делать в Delphi.

[VVA]

Тяжело в начале, до тех пор, пока будешь себя ловить на том, что 1+1 хочешь записать как (1 + 1), а не (+ 1 1). Хотя надо признать, что работая с Автокадом и Лиспом с 1990 года, относительно недавно раскрыл для себя в полной мере потенциал функций lambda, mapcar и apply, в результате чего изменился стиль программирования и, наверное, я ближе стал к пониманию "Мира Лиспа". Хотя до таких колоссов как Michael Puckett далеко.
Если ты поймешь как работает этот пример, станешь на порядок ближе к пониманию сущности лиспа.

Код:

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

 
(apply 'mapcar (cons 'list '((1 4 7)(2 5 8)(3 6 9))))

В свое время я делал это пошагово с карандашом в руках.
Вот страничка Michael Puckett. Там много хороших примеров.
Удачи в освоении этого интересного языка.

[Alaspher]

Сообщение от VVA На почившем в бозе autocad.ru Евгений Елпанов выкладывал такую ф-цию...

При всём уважении к Евгению, выложенный код всёже несколько запутан. В качестве альтернативы, можно посмотреть более простой вариант реализации:

Код:

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

(defun demo (/ adoc asel maxlst maxpnt minlst minpnt)
    (setq adoc (vla-get-activedocument (vlax-get-acad-object))
          asel (vla-get-activeselectionset adoc)
    )
    (vla-clear asel)
    (pl:obj-select-on-screen asel "*")
    (vlax-for i asel
        (vla-getboundingbox i 'minpnt 'maxpnt)
        (setq minlst (cons (vlax-safearray->list minpnt) minlst)
              maxlst (cons (vlax-safearray->list maxpnt) maxlst)
        )
    )
    (list (apply (function mapcar) (cons (function min) minlst))
          (apply (function mapcar) (cons (function max) maxlst))
    )
)
(defun pl:obj-select-on-screen (sel enttype)
    (vla-selectonscreen
        sel
        (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 0)) '(0))
        (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 0)) (list enttype))
    )
)
(vl-load-com)
 
(demo)

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

Безотносительно логики кода (она, как всегда, безупречна), вопрос: а asel не надо очищать? Я-то обычно иду через ssget....

[Alaspher]

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

[Лентяй]

Сообщение от Кулик Алексей aka kpblc Безотносительно логики кода (она, как всегда, безупречна), вопрос: а asel не надо очищать?

Если ActiveSelectionSet обозначать правильно, т.е. ass, то строка

Код:

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

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

пишется сама собой

Я-то обычно иду через ssget....

Из бессмертного: "В _______ (вписать нужное - армии, России, нашей фирме) все делается через ________ (вписать нужное - censed, censed, ssget).

[Profan]

В результате работы функции (vla-GetBoundingBox) мы получаем 2 крайние точки габаритного контейнера. Но правильно ли мы трактуем эти точки, строя по ним прямоугольник?
Вот простейшая программа:

Код:

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

(defun C:BO ( / echo obj B pmin pmax) 
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq obj (car (entsel "\nВыберите объект: ")))
(setq B (vlax-ename->vla-object obj))
(vla-GetBoundingBox B 'minp 'maxp)
(setq pmin (vlax-safearray->list minp) pmax (vlax-safearray->list maxp))
(vl-cmdf "_RECTANG" pmin pmax)
(setvar "CMDECHO" echo)
(princ)
)

Во вложении простейший пример с блоком и полилинией. Получается странная картина. Если угол поворота блока не равен 0, то прямоугольник получается больше, чем в случае полилинии.
Почему так происходит?
Аналогичный результат происходит и при использовании приведенных в этой теме программ. Кстати, программа Alaspher вообще работает 1 или 2 раза и вырубается.

[Дима_]

Сообщение от Profan Почему так происходит?

Для блока выдаются габариты повернутого габаритного контейнера, а не его содержимого.

[Profan]

Если эти операции произвести вручную: задать угол поворота блока = 0, получить габаритный прямоугольник, повернуть его на исходный угол и получить новый габаритный прямоугольник, то именно так и получается. (Неужели AutoCAD именно так и делает? И зачем?)
Но вот есть задача:
Имеется несколько разных объектов, в том числе и повернутый блок. Необходимо построить габаритный прямоугольник для всех этих объектов.
Как это корректно выполнить?

[Дима_]

Самое простое - рекурсивно взорвать все вхождения блоков.

[Profan]

Видимо, так и придется сделать.

[trir]

Для слияния MBR - нужно просто найти минимальное и максимальное значение для каждой размерности

[Profan]

MBR - Master Boot Record (Главная Загрузочная Запись). Для слияния разделов на жестком диске я обычно использую Acrinis или Paragon. Эти программы сами показывают минимальные и максимальные размеры разделов.

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

trir, Profan, вы про что?

[trir]

Minimum bounding rectangle, also known as bounding box or envelope

Код:

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

        public void add(Rectangle r)
        {
            for (int i = 0; i < DIMENSIONS; i++)
            {
                if (r.min[i] < min[i])
                {
                    min[i] = r.min[i];
                }
                if (r.max[i] > max[i])
                {
                    max[i] = r.max[i];
                }
            }
        }

[Profan]

Сообщение от Кулик Алексей aka kpblc trir, Profan, вы про что?

Не знаю, я наугад ляпнул про то, что мне доступно.
А вообще, мне бы хотелось увидеть рабочий вариант кода, а не теоретические выкладки. Я, все-таки, не инженер Lisp.

[skkkk]

Сообщение от Profan Имеется несколько разных объектов, в том числе и повернутый блок. Необходимо построить габаритный прямоугольник для всех этих объектов. Как это корректно выполнить?

Selection Set Bounding Box?
Правда, с повернутым блоком тот же "плохой" результат.

[VVA]

Profan, skkkk, Пока проверить нет возможноти. Попробуйте ф-цию LM:blockreferenceboundingbox отсюда Justify Block Base Point

Код:

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

;; Block Reference Bounding Box  -  Lee Mac
;; Returns a WCS point list describing a rectangular frame bounding all geometry of a supplied block reference.
;; Excludes Text, MText & Attribute Definitions.
;; ref - [vla] Block Reference Object
 (defun LM:blockreferenceboundingbox ( ref )

[skkkk]

VVA, результат - красный прямоугольник. По-моему, это не то, что нужно Profan'у. Насколько я понял, он хочет ортогональный boundingbox.

[Дима_]

В общем надо размяться (на автолиспе давно не писал - так что если вдруг - не ругайте сильно).

Код:

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

 (vl-load-com)
(defun block-bound-box(ent / minpt maxpt)
  ((lambda (ent-ob)
     (if (= (cdr (assoc 0 (entget (car ent-ob)))) "INSERT")
         ((lambda (lst-ob)
            ((lambda (lst-minpt-maxpt)
               (mapcar 'vla-delete lst-ob)
               ((lambda (lst-minpt lst-maxpt)
                  (cons (list (apply 'min (mapcar 'car lst-minpt))
                              (apply 'min (mapcar 'cadr lst-minpt))
                              0.0)
                        (list (apply 'max (mapcar 'car lst-maxpt))
                              (apply 'max (mapcar 'cadr lst-maxpt))
                              0.0)))
                (mapcar 'car lst-minpt-maxpt)
                (mapcar 'cdr lst-minpt-maxpt)))
             (mapcar 'block-bound-box lst-ob)))
          (vlax-safearray->list (vlax-variant-value (vla-explode (cdr ent-ob)))))
         (progn (vla-getboundingbox (cdr ent-ob) 'minpt 'maxpt)
                (cons (vlax-safearray->list minpt) (vlax-safearray->list maxpt)))))
   (if (= (type ent) 'ename)
       (cons ent (vlax-ename->vla-object ent))
       (cons (vlax-vla-object->ename ent) ent))))

Пример вызова (block-bound-box (entlast)) - Возвращает пару (minPt . maxPt)
Для проверки:

Код:

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

 (defun test-bound (pt1-pt2)
  (entmakex (list '(0 . "LINE") (cons 10 (car pt1-pt2)) (cons 11 (cdr pt1-pt2)))))

Вызов что-то вроде (test-bound (block-bound-box (car (entsel))))

з.ы. - как далее вспомнил Крыс - с внешними ссылками работать не будет.

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

Дима_, внешнюю ссылку не расколотишь

[Дима_]

Почему? Не проверял - она-же вроде как обычный "insert"

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

Насколько я помню (сейчас проверять лениво), у нее метод explode не срабатывает. И, кстати, не должен

[Дима_]

А точно - было такое - ну значит - НЕ СРАБОТАЕТ (по крайней мере в старых версиях точно) - кто хочет может добавить расширенную версию.

[Profan]

Сообщение от skkkk VVA, результат - красный прямоугольник. По-моему, это не то, что нужно Profan'у. Насколько я понял, он хочет ортогональный boundingbox.

Программу Lee Mac я тоже пробовал.
Но skkkk прав. Это не то, что нужно, хотя программа интересная. Нужен для начала действительно ортогональный габарит. А в реальности нужен габарит под произвольным (задаваемым) углом к осям координат. Когда я искал решение, я как раз и натолкнулся на эту проблему с повернутым блоком.
А почему тут всплыли внешние ссылки?
Дима_, твоя программа выдает список координат в виде
((3758.36 777.809 0.0) 4154.0 1173.44 0.0)
а это неправильно.

[Дима_]

Почему неправильно? Она не выдает список координат - она выдает пару (car и cdr) из координат.
Ну если хотите список (хотя в моем понимании здесь он как раз не является правильным) - в строках 9,20 меняем cons на list, в строке 16 cdr на cadr.

[Profan]

Ну, понятно, это ты под себя делал, функциями. Я-то хочу увидеть габарит.
Вот при таком варианте функции

Код:

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

(defun test-bound (pt1-pt2)
(entmakex (list '(0 . "LINE") (cons 10 (setq gpt1 (car pt1-pt2))) (cons 11 (setq gpt2 (cdr pt1-pt2)))))
(vl-cmdf "_RECTANG" gpt1 gpt2)
)

я этот габарит увидел. И похоже, что это как раз то, что нужно.
Спасибо.
Команду для пользователей сварганю сам

----- добавлено через ~1 ч. -----
Вот окончательный вариант программы построения габаритного контура для нескольких объектов под заданным углом:

Код:

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

;;; Повернутый габарит нескольких объектов
;;; Используются функции от Дима_
;;; http://forum.dwg.ru/showthread.php?t=14437
(defun C:ГНО ( / echo ss tvs ugol rbl gpt1 gpt2) 
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq ss (ssget))
(princ "\nУкажите базовую точку: ")
(vl-cmdf "_-BLOCK" "BBOX" pause ss "")
(setq tvs (getvar "LASTPOINT"))
(vl-cmdf "_-INSERT" "BBOX" tvs "1" "1" "0")
(initget 1)
(setq ugol (getreal "\nУгол поворота: "))
(vl-cmdf "_ROTATE" "_L" "" tvs ugol)
(setq rbl (entlast))
;;; Функции от Дима_
(defun block-bound-box(ent / minpt maxpt)
  ((lambda (ent-ob)
     (if (= (cdr (assoc 0 (entget (car ent-ob)))) "INSERT")
         ((lambda (lst-ob)
            ((lambda (lst-minpt-maxpt)
               (mapcar 'vla-delete lst-ob)
               ((lambda (lst-minpt lst-maxpt)
                  (cons (list (apply 'min (mapcar 'car lst-minpt))
                              (apply 'min (mapcar 'cadr lst-minpt))
                              0.0)
                        (list (apply 'max (mapcar 'car lst-maxpt))
                              (apply 'max (mapcar 'cadr lst-maxpt))
                              0.0)))
                (mapcar 'car lst-minpt-maxpt)
                (mapcar 'cdr lst-minpt-maxpt)))
             (mapcar 'block-bound-box lst-ob)))
          (vlax-safearray->list (vlax-variant-value (vla-explode (cdr ent-ob)))))
         (progn (vla-getboundingbox (cdr ent-ob) 'minpt 'maxpt)
                (cons (vlax-safearray->list minpt) (vlax-safearray->list maxpt)))))
   (if (= (type ent) 'ename)
       (cons ent (vlax-ename->vla-object ent))
       (cons (vlax-vla-object->ename ent) ent)))
)
(defun test-bound (pt1-pt2)
(setq gpt1 (car pt1-pt2) gpt2 (cdr pt1-pt2))
(vl-cmdf "_RECTANG" "_none" gpt1 "_none" gpt2)
(setq rect (entlast))
)
(test-bound (block-bound-box rbl))
;;;
(vl-cmdf "_ROTATE" rbl rect "" tvs (- 0 ugol))
(vl-cmdf "_EXPLODE" rbl)
(vl-cmdf "_-PURGE" "_B" "" "_N")
(princ "\n\nГабарит построен")
(setvar "CMDECHO" echo)
(princ)
)

[Дима_]

Я вот никак не могу понять почему вместо

Код:

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

 (setq gpt1 (car pt1-pt2) gpt2 (cdr pt1-pt2))
(vl-cmdf "_RECTANG" "_none" gpt1 "_none" gpt2)

не написать

Код:

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

 (vl-cmdf "_RECTANG" "_none" (car pt1-pt2) "_none" (cdr pt1-pt2))

Вы же нигде и никогда их использовать больше не будете???

[Profan]

Умом Profana не понять. Это же только первый вариант, тут можно еще что-нибудь наоптимизировать. Может, кто-нибудь еще что-нибудь сочинит. Попроще, без нагромождения функций.
А вообще некоторые здесь любят писать: "Не проверял", "Делал на коленке" и т.д. и т.п.

[Profan]

Вариант без указания базовой точки:

Код:

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

;;; Построение габаритного контура нескольких объектов под заданным углом
;;; Используются функции от Lee Mac http://www.lee-mac.com/ssboundingbox.html
;;; и Дима_ http://forum.dwg.ru/showthread.php?t=14437
;;; ГНОБ - Габарит Нескольких ОБъектов
(defun C:ГНОБ ( / echo sel idx obj ls1 ls2 ptrot ugol rbl gpt1 gpt2) 
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq sel (ssget))
;;; Функции от Lee Mac
(repeat (setq idx (sslength sel))
        (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
        (if (and (vlax-method-applicable-p obj 'getboundingbox)
                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
            )
            (setq ls1 (mapcar 'min (vlax-safearray->list llp) (cond (ls1) ((vlax-safearray->list llp))))
                  ls2 (mapcar 'max (vlax-safearray->list urp) (cond (ls2) ((vlax-safearray->list urp))))
            )
        )
)
;;;
(setq ptrot (list (/ (+ (nth 0 ls2) (nth 0 ls1)) 2) (/ (+ (nth 1 ls2) (nth 1 ls1)) 2)))
(vl-cmdf "_-BLOCK" "BBOX" ptrot sel "")
(vl-cmdf "_-INSERT" "BBOX" ptrot "1" "1" "0")
(initget 1)
(setq ugol (getreal "\nУгол поворота: "))
(vl-cmdf "_ROTATE" "_L" "" ptrot ugol)
(setq rbl (entlast))
;;; Функции от Дима_
(defun block-bound-box(ent / minpt maxpt)
  ((lambda (ent-ob)
     (if (= (cdr (assoc 0 (entget (car ent-ob)))) "INSERT")
         ((lambda (lst-ob)
            ((lambda (lst-minpt-maxpt)
               (mapcar 'vla-delete lst-ob)
               ((lambda (lst-minpt lst-maxpt)
                  (cons (list (apply 'min (mapcar 'car lst-minpt))
                              (apply 'min (mapcar 'cadr lst-minpt))
                              0.0)
                        (list (apply 'max (mapcar 'car lst-maxpt))
                              (apply 'max (mapcar 'cadr lst-maxpt))
                              0.0)))
                (mapcar 'car lst-minpt-maxpt)
                (mapcar 'cdr lst-minpt-maxpt)))
             (mapcar 'block-bound-box lst-ob)))
          (vlax-safearray->list (vlax-variant-value (vla-explode (cdr ent-ob)))))
         (progn (vla-getboundingbox (cdr ent-ob) 'minpt 'maxpt)
                (cons (vlax-safearray->list minpt) (vlax-safearray->list maxpt)))))
   (if (= (type ent) 'ename)
       (cons ent (vlax-ename->vla-object ent))
       (cons (vlax-vla-object->ename ent) ent)))
)
(defun test-bound (pt1-pt2)
(setq gpt1 (car pt1-pt2) gpt2 (cdr pt1-pt2))
(vl-cmdf "_RECTANG" "_none" gpt1 "_none" gpt2)
(setq rect (entlast))
)
(test-bound (block-bound-box rbl))
;;;
(vl-cmdf "_ROTATE" rbl rect "" ptrot (- 0 ugol))
(vl-cmdf "_EXPLODE" rbl)
(vl-cmdf "_-PURGE" "_B" "" "_N")
(princ "\n\nГабарит построен")
(setvar "CMDECHO" echo)
(princ)
)