[ASLYS]

есть нескольно объектов 3D нужно получить габариты этой группы
для 2D понятно, рисую прямоугольник, и получаю размеры, а с 3D не получается (получить разницу между Zmin и Zmax для текущей системы координат)

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

Для одного объекта:

Код:

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

(defun getext (/ ent minp maxp)
  (if
    (and
      (not
        (vl-catch-all-error-p
          (vl-catch-all-apply
            (function
              (lambda ()
                (setq ent (car (entsel "\nУкажите солид <Отмена> : ")))
                ) ;_ end of lambda
              ) ;_ end of function
            ) ;_ end of vl-catch-all-apply
          ) ;_ end of vl-catch-all-error-p
        ) ;_ end of not
      ent
      (= (cdr (assoc 0 (entget ent))) "3DSOLID")
      ) ;_ end of and
     (progn
       (vla-getboundingbox (vlax-ename->vla-object ent) 'minp 'maxp)
       (setq minp (trans (vlax-safearray->list minp) 0 1)
             maxp (trans (vlax-safearray->list maxp) 0 1)
             ) ;_ end of setq
       ) ;_ end of progn
     ) ;_ end of if
  (list minp maxp)
  ) ;_ end of defun

Для нескольких:

Код:

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

(defun getext2 (/ selset pt_lst)
  (if
    (and
      (not
        (vl-catch-all-error-p
          (vl-catch-all-apply
            (function
              (lambda ()
                (setq selset (ssget '((0 . "3DSOLID"))))
                ) ;_ end of lambda
              ) ;_ end of function
            ) ;_ end of vl-catch-all-apply
          ) ;_ end of vl-catch-all-error-p
        ) ;_ end of not
      selset
      ) ;_ end of and
     (progn
       (setq
         pt_lst (apply
                  'append
                  (mapcar '(lambda (x / minp maxp)
                             (vla-getboundingbox
                               (vlax-ename->vla-object x)
                               'minp
                               'maxp
                               ) ;_ end of vla-getboundingbox
                             (list (trans (vlax-safearray->list minp) 0 1)
                                   (trans (vlax-safearray->list maxp) 0 1)
                                   ) ;_ end of list
                             ) ;_ end of lambda
                          (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
                          ) ;_ end of mapcar
                  ) ;_ end of apply
         ) ;_ end of setq
       ) ;_ end of progn
     ) ;_ end of if
  (if pt_lst
    (list (list (apply 'min (mapcar 'car pt_lst))
                (apply 'min (mapcar 'cadr pt_lst))
                (apply 'min (mapcar 'caddr pt_lst))
                ) ;_ end of list
          (list (apply 'max (mapcar 'car pt_lst))
                (apply 'max (mapcar 'cadr pt_lst))
                (apply 'max (mapcar 'caddr pt_lst))
                ) ;_ end of list
          ) ;_ end of list
    ) ;_ end of if
  ) ;_ end of defun

Возвращает список точек - самая нижняя левая и самая верхняя правая.

[ASLYS]

спасибо

[ASLYS]

Алексей, извини за ламерский вопрос, но для чего нужно делать так

Код:

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

(if(and 
      (not 
        (vl-catch-all-error-p 
          (vl-catch-all-apply 
            (function 
              (lambda () 
                (setq selset (ssget '((0 . "3DSOLID")))) 
                ) ;_ end of lambda 
              ) ;_ end of function 
            ) ;_ end of vl-catch-all-apply 
          ) ;_ end of vl-catch-all-error-p 
        ) ;_ end of not 
      selset 
      ) ;_ end of and 
   ...

можно сделать проще...

Код:

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

(if (setq selset (ssget '((0 . "3DSOLID")))) ...

или не стоит?

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

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

[Евгений А.]

А если не воротить лишнего коду, то можно сделать коротко и красиво:

Код:

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

(if (= (type
             (setq selset (vl-catch-all-apply 'ssget '(((0 . "3DSOLID")))))
             ) ;_ end type
           'PICKSET
           ) ;_ end equal
  selset
  nil
  ) ;_ end if

Как говорится - нет предела совершенству!!! :shock:

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

Кто бы спорил, да только не я. Мой код - следствие привычки, наверное. И испорченности VB(A)

[Дмитррр]

Так можно же совсем понубскому поступить [sm2103]
Поставить объект, что бы ось Z была в экране, нарисовать линию от самого верха до самого низа, и просто при помощи команды (забыл как называется) померить дельта зед. Даже линию можно не рисовать.