vla-GetBoundingBox

vla-GetBoundingBox · 24.10.2007, 17:05

Код:

 
(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 для списка объектов?

Спасибо.

Profan · 23.01.2017, 09:32

Цитата:

Сообщение от Кулик Алексей aka kpblc

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

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

skkkk · 23.01.2017, 12:46

Цитата:

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

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

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

VVA · 23.01.2017, 22:30

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 · 23.01.2017, 23:27

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

Дима_ · 24.01.2017, 03:36

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

Код:

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

 (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 · 24.01.2017, 08:36

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

Дима_ · 24.01.2017, 08:52

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

Кулик Алексей aka kpblc · 24.01.2017, 08:55

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

Дима_ · 24.01.2017, 09:02

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

Profan · 24.01.2017, 09:30

Цитата:

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

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

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

Дима_ · 24.01.2017, 09:40

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

Profan · 24.01.2017, 10:46

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

Код:

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

(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)
)

Дима_ · 24.01.2017, 12:26

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

Код:

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

 (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 · 24.01.2017, 12:33

Умом Profana не понять.

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

Profan · 26.01.2017, 10:42

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

Код:

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

;;; Построение габаритного контура нескольких объектов под заданным углом
;;; Используются функции от 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)
)

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Как по координатам из метода GetBoundingBox уменьшить размер	disintegrator	Программирование	8	26.10.2005 23:35

24.10.2007, 17:05
vla-GetBoundingBox DY Москва Регистрация: 21.12.2006 Сообщений: 110 Код: [Выделить все] (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 для списка объектов? Спасибо.
Просмотров: 8600

	Реклама i