• Миша
  • Восстановленный участник
  • На форуме с 31 декабря 2001г.
  • Сообщений: 322
  • Спасибо: 0

Тема: Как выполнить команду Pan или получить доступ к scrollaм методами VBA?

Помогите пожалуйста выполнить команду Pan или получить доступ к scrollaм методами VBA.
Метода Pan в VBA не существует, однако метод Zoom есть.
Как осуществляется команда Pan в VBA?
Scrollы AutoCAD только можно вывести на экран или отобразить их с помощью свойства ThisDrawing.Application.preferences.Display.DisplayScrollBars.
А как получить доступ к значениям Scrollов?

  • Maxim T
  • Восстановленный участник
  • На форуме с 1 августа 2003г.
  • Сообщений: 628
  • Спасибо: 0

Re: Как выполнить команду Pan или получить доступ к scrollaм методами VBA?

> Миша
Есть системные переменные, в которых хранится "точка зрения" (для перспективного вида), координаты центра экрана и его высота в ед. автокада, а также пропорции всех видовых экранов - "плиток". Вот через эти переменные. Только я сейчас не помню их имён :( Помню, что на VIEW... начинается, посмотри в хелпе, а там дальше по ссылкам...

  • Миша
  • Восстановленный участник
  • На форуме с 31 декабря 2001г.
  • Сообщений: 322
  • Спасибо: 0

Re: Как выполнить команду Pan или получить доступ к scrollaм методами VBA?

У меня получилось разработать код для масштабирования и панорамирования чертежа с помощью кнопок формы. Код отлично работает. Проверьте сами:

Option Explicit
Dim dblНачКоордXЦентраЭкрана As Double
Dim dblНачКоордYЦентраЭкрана As Double
Dim dblПоловинаШириныЭкрана As Double
Dim dblПоловинаВысотыЭкрана As Double
Dim dblМасштабныйКоэффициент As Double
Dim dblDeltaXЦентра As Double
Dim dblDeltaYЦентра As Double
Private Sub UserForm_Initialize()
Dim dblМинимКоордXЭкрана As Double
Dim dblМаксКоордXЭкрана As Double
Dim dblМинимКоордYЭкрана As Double
Dim dblМаксКоордYЭкрана As Double
Dim dblВысотаЭкрана As Double
Dim vТочка As Variant
Dim vЦентрЭкрана As Variant
   vТочка = ThisDrawing.GetVariable("VSMIN")
   dblМинимКоордXЭкрана = vТочка(0)
   dblМинимКоордYЭкрана = vТочка(1)
   vТочка = ThisDrawing.GetVariable("VSMAX")
   dblМаксКоордXЭкрана = vТочка(0)
   dblМаксКоордYЭкрана = vТочка(1)
   dblНачКоордXЦентраЭкрана = (dblМинимКоордXЭкрана + dblМаксКоордXЭкрана) / 2
   dblНачКоордYЦентраЭкрана = (dblМинимКоордYЭкрана + dblМаксКоордYЭкрана) / 2
   dblПоловинаШириныЭкрана = (dblМаксКоордXЭкрана - dblМинимКоордXЭкрана) / 2
   dblПоловинаВысотыЭкрана = (dblМаксКоордYЭкрана - dblМинимКоордYЭкрана) / 2
   vЦентрЭкрана = ThisDrawing.GetVariable("VIEWCTR")
   dblDeltaXЦентра = vЦентрЭкрана(0) - dblНачКоордXЦентраЭкрана
   dblDeltaYЦентра = vЦентрЭкрана(1) - dblНачКоордYЦентраЭкрана
   dblВысотаЭкрана = ThisDrawing.GetVariable("VIEWSIZE")
   dblМасштабныйКоэффициент = dblВысотаЭкрана / (dblПоловинаВысотыЭкрана * 2)
End Sub
Private Sub CommandButton4_УменьшитьМасштаб_Click()
   dblМасштабныйКоэффициент = 1.01 * dblМасштабныйКоэффициент
   Call ОтобразитьТекущийВидовойЭкран
End Sub
Private Sub CommandButton5_УвеличитьМасштаб_Click()
   dblМасштабныйКоэффициент = 0.99 * dblМасштабныйКоэффициент
   Call ОтобразитьТекущийВидовойЭкран
End Sub
Private Sub CommandButton6_Влево_Click()
Dim dblВысотаЭкрана As Double
   dblВысотаЭкрана = ThisDrawing.GetVariable("VIEWSIZE")
   dblDeltaXЦентра = dblDeltaXЦентра + 0.01 * dblВысотаЭкрана
   Call ОтобразитьТекущийВидовойЭкран
End Sub
Private Sub CommandButton7_Вправо_Click()
Dim dblВысотаЭкрана As Double
   dblВысотаЭкрана = ThisDrawing.GetVariable("VIEWSIZE")
   dblDeltaXЦентра = dblDeltaXЦентра - 0.01 * dblВысотаЭкрана
   Call ОтобразитьТекущийВидовойЭкран
End Sub
Private Sub CommandButton8_Вверх_Click()
Dim dblВысотаЭкрана As Double
   dblВысотаЭкрана = ThisDrawing.GetVariable("VIEWSIZE")
   dblDeltaYЦентра = dblDeltaYЦентра - 0.01 * dblВысотаЭкрана
   Call ОтобразитьТекущийВидовойЭкран
End Sub
Private Sub CommandButton9_Вниз_Click()
Dim dblВысотаЭкрана As Double
   dblВысотаЭкрана = ThisDrawing.GetVariable("VIEWSIZE")
   dblDeltaYЦентра = dblDeltaYЦентра + 0.01 * dblВысотаЭкрана
   Call ОтобразитьТекущийВидовойЭкран
End Sub
Public Function ОтобразитьТекущийВидовойЭкран()
Dim dblLowLeftPoint(0 To 2) As Double, dblUpperRightPoint(0 To 2) As Double
   dblLowLeftPoint(0) = -dblМасштабныйКоэффициент * dblПоловинаШириныЭкрана + dblНачКоордXЦентраЭкрана
+ dblDeltaXЦентра
   dblLowLeftPoint(1) = -dblМасштабныйКоэффициент * dblПоловинаВысотыЭкрана + dblНачКоордYЦентраЭкрана
+ dblDeltaYЦентра
   dblUpperRightPoint(0) = dblМасштабныйКоэффициент * dblПоловинаШириныЭкрана +
dblНачКоордXЦентраЭкрана + dblDeltaXЦентра
   dblUpperRightPoint(1) = dblМасштабныйКоэффициент * dblПоловинаВысотыЭкрана +
dblНачКоордYЦентраЭкрана + dblDeltaYЦентра
   ZoomWindow dblLowLeftPoint, dblUpperRightPoint
End Function

  • Миша
  • Восстановленный участник
  • На форуме с 31 декабря 2001г.
  • Сообщений: 322
  • Спасибо: 0

Re: Как выполнить команду Pan или получить доступ к scrollaм методами VBA?

Спасибо Maximу T за дельный совет!