• VadimR
  • Восстановленный участник
  • На форуме с 16 июня 2008г.
  • Сообщений: 5
  • Спасибо: 0

Тема: Изменение размеров формы + ZoomExtents

Необходимо перед экспортом чертежа в картинку
1.уменьшить размер окна
2.сделать ZoomExtents
Public Sub ExportWindowToImage()
    If ThisDrawing.ModelSpace.Count = 0 Then
        MsgBox "Drawing is empty"
        Exit Sub
    End If
   Dim memHeight as Integer, memWidth as Integer
   memHeight  = ThisDrawing.Width
   memWidth   = ThisDrawing.Height
   ThisDrawing.Width = 131
   ThisDrawing.Height = 142
   ZoomExtents
  ....................... Export......................
   ThisDrawing.Width = memWidth
   ThisDrawing.Height =  memHeight
   ZoomExtents
End Sub
Проблемы:
1. после выполнения присвоений
   ThisDrawing.Width = 131
   ThisDrawing.Height = 142
уменьшаются открытые окна, а не одно текущее.
2. ZoomExtents выполняется неустойчиво

  • LeonidSN
  • Активный участник
  • На форуме с 30 мая 2005г.
  • Сообщений: 1,480
  • Спасибо: 5

Re: Изменение размеров формы + ZoomExtents

Попробуй так:

Public Sub ExportWindowToImage()
    If ThisDrawing.ModelSpace.Count = 0 Then
        MsgBox "Drawing is empty"
        Exit Sub
    End If
    Dim memHeight As Long, memWidth As Long
    memHeight = ThisDrawing.Width
    memWidth = ThisDrawing.Height
    ThisDrawing.Width = 131
    ThisDrawing.Height = 142
    '....................... Export......................
    ThisDrawing.Width = memWidth
    ThisDrawing.Height = memHeight
    ThisDrawing.SendCommand "_zoom" & vbCr & "_e" & vbCr
   ' Refresh view
   ThisDrawing.Regen acActiveViewport
End Sub