[den001]

Кто пишет на VBA, помогите!
Нужно программно выбрать объекты

Set Sset = ThisDrawing.SelectionSets.Add("ddd")
Sset.Select acSelectionSetCrossing, p1, p2, ft, fd

Если точки p1, p2 находятся вне видимой области (за пределами экрана), команда не работает.
Как проверить, где они? Кто сталкивался с такой проблемой и кто как ее решил?
(безусловное зумирование не предлагать )

[VVA]

Я пишу на лиспе, но, думаю, аглоритм от эго не поменяется.

Код:

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

;;;Библиотечные функции МинскИнжПроект
;;;Ф-ция переводит градусы в радианы ( dtr a)
(defun DTR (a)(* pi (/ a 180.0)))
;;;------------------------------------------------------------------------------- 
;;;Ф-ция переводит радианы в градусы ( R2D a)
(defun RTD (a)(/ (* a 180.0) pi))
;| ! *******************************************************************
;; !                  lib:IsPtInView
;; ! *******************************************************************
;; ! Проверяет находится ли точка в видовом экране
;; ! Auguments: 'pt'  - Точка для анализа в МСК!!!
;; ! Return   : T или nil если 'pt' в видовом экране или нет
;; ! *******************************************************************|;
(defun lib:IsPtInView (pt / VCTR Y_Len SSZ X_Pix Y_Pix X_Len Lc Uc)
  (setq pt (trans pt 0 1))          ;_Транслируем координаты из МСК в ПСК
  (setq	VCTR  (getvar "VIEWCTR")    ;_Центр вида на текущем видовом экране . (в координатах ПСК).
	Y_Len (getvar "VIEWSIZE")   ;_Высота вида на текущем видовом экране, выраженная в единицах рисунка 
	SSZ   (getvar "SCREENSIZE") ;_Размер текущего видового экрана в пикселах (по X и Y).
	X_Pix (car SSZ)             ;_Размер текущего видового экрана в пикселах по X.
	Y_Pix (cadr SSZ)            ;_Размер текущего видового экрана в пикселах по Y.
	X_Len (* (/ X_Pix Y_Pix) Y_Len) ;_Размер по Х вида, выраженный в единицах рисунка
	Lc    (polar VCTR (dtr 180.0) (* 0.5 X_Len))
	Uc    (polar Lc 0.0 X_Len)
	Lc    (polar Lc (dtr 270.0) (* 0.5 Y_Len)) ;_Левый нижний угол видового экрана
	Uc    (polar Uc (dtr 90.0) (* 0.5 Y_Len))  ;_Правый верхний угол видового экрана
  )
  (if (and (> (car pt) (car Lc))  ;_Сама проверка (car pt) - X (cadr pt)-Y
	   (< (car pt) (car Uc))
	   (> (cadr pt) (cadr Lc))
	   (< (cadr pt) (cadr Uc))
      )
    T
    nil
  )
)
 ;| ! ***************************************************************************
;; !           lib:pt_extents
;; ! ***************************************************************************
;; ! Function : Возвращает границы MIN, MAX X,Y,Z списка точек
;; ! Argument : 'vlist' - Список точек
;; ! Returns  : Список точек (ЛевНижн ПравВерхн)
;; ! ***************************************************************************|;
(defun lib:pt_extents (vlist / tmp)
  (setq
    tmp	(mapcar
	  '(lambda (x) (vl-remove-if 'null x))
	  (mapcar
	    '(lambda (what) (mapcar '(lambda (x) (nth what x)) vlist))
	    '(0 1 2)
	  )
	)
  ) ;_setq
  (list	(mapcar '(lambda (x) (apply 'min x)) tmp)
	(mapcar '(lambda (x) (apply 'max x)) tmp)
  )
) ;_defun

;; ! ***********************************************************
;; !                             lib:Zoom2Lst
;; ! **********************************************************
;; ! Function : Zoom границ списка точек
;; ! Arguments: 'vlist' - Список точек в МСК!!!!
;; ! Зуммирует экран, чтобы все точки были видны
;; ! Returns  : t - было зуммирование nil - нет
;; ! **********************************************************
(defun lib:Zoom2Lst (vlist / bl tr Lst OS)
  (setq	Lst (lib:pt_extents vlist)
	bl  (car Lst) ;_Bottom Left
	tr  (cadr Lst);_Top Right
  )
  (if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr)))
    (progn (setq OS (getvar "OSMODE"))
	   (setvar "OSMODE" 0)
	   (command "_.Zoom"
		    "_Window"
		    (trans bl 0 1)
		    (trans tr 0 1)
		    "_.Zoom"
		    "0.95x"
	   )
	   (setvar "OSMODE" OS)
	   T
    )
    NIL
  )
)

Алгоритм такой:
1. Есть список VLIST из точек p1, p2, ft, fd.
2. Ф-ция lib:Zoom2Lst находит из списка VLIST точки Xmin, Ymin и Xmax,Ymax (ф-ция lib:pt_extents ) и проверяет их на предмет нахождения в видовом зкране (своего рода габарит)[(if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr)))] и если не так, то зуммируем окном по точкам Xmin,Ymin и Xmax,Ymax и для надежности еще 0.95x
Думаю реализовать этот аглоритм на VBA будет не сложно.

[fixo]

Сначала

Код:

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

ZoomWindow p1,p2

потом уже следует выбор

Если в набор надо собрать все с опцией acSelectionSetAll

тогда предварительно:

Код:

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

ZoomAll

~'J'~

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

По-моему, acSelectionSetAll аналогичен (ssget "_X"), то есть выбирает вообще все примитивы, даже лежащие в других пространствах или на отключенных / замороженных слоях. Или нет?

[den001]

VVA: СПАСИБО!

kpbIc: acSelectionSetAll выбирает все примитивы, кроме находящихся на замороженных слоях, но это, в принципе, ни к чему.
чтобы пройтись по всем объектам, лучше сделать так:

Код:

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

Dim Ent as AcadEntity
For Each Ent in ThisDrawing.MolelSpace
   Ent.(что душе угодно)
Next

[den001]

Интересная фигня: я искал, в принципе, в этой области, но не через системные переменные а через свойства

ThisDrawing.ActiveViewport.Height
ThisDrawing.ActiveViewport.Width

А они, сволочи, почему-то, как-то странно обновляются: вид изменен, а они остаются прежние. Чуть мозги не вывихнул!! После сохранения чертежа - обновляются (только сейчас увидел). А системные переменные обновляются мгновенно. Что за хрень??? :?

VVA, еще раз спасибо! :wink:

[den001]

Кстати, о птицах. Совсем забыл выложить, что получилось. Может, кому сгодится.

Код:

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

Function PointIsAway(Point As ACAD_POINT) As Boolean
    Dim UpRh(2) As Double, DnLf(2) As Double
    PointIsAway = False
    scr = ThisDrawing.GetVariable("SCREENSIZE")
    Yd = ThisDrawing.GetVariable("VIEWSIZE")
    Xd = scr(0) / scr(1) * Yd
    Cen = ThisDrawing.GetVariable("VIEWCTR")
    Cen = ThisDrawing.Utility.TranslateCoordinates(Cen, acUCS, acWorld, 0)
    UpRh(0) = Cen(0) + Xd / 2: UpRh(1) = Cen(1) + Yd / 2
    DnLf(0) = Cen(0) - Xd / 2: DnLf(1) = Cen(1) - Yd / 2
    If Point(0) < DnLf(0) Or Point(1) < DnLf(1) Or Point(0) > UpRh(0) Or Point(1) > UpRh(1) Then PointIsAway = True
End Function