ViewSize

12Jan07

Macro to resize the model view for screen captures

Saving your models as pictures for documentation ? Then you know the problem : the images will have 912×534 pixels one day and 1143×712 the day after. If you don’t want to edit your images in a second step, here is a macro that sets the graphic area to a specified size:

'ViewSize : SolidWorks macro to size the view (for screen captures)
'Author : Ph. Guglielmetti, (c) 2004, DynaBits sàrl Switzerland, all rights reserved
'Licence: you may use this macro for free, as long as this header is kept untouched.
'License: no support is provided, except for e-Systems customers
'Licence: it is forbidden to sell this code or publish it elsewhere without our permission
'Revision : 2004-01-12 PhG v 1.0 Tricky! : uses a WinAPI call to read the Frame's DIBSECTION size values

Option Explicit

Private Const fh As Long = 800 ' horizontal size in pixels
Private Const fv As Long = 600 ' vertical size in pixels

Private Declare Sub RtlMoveMemory Lib "kernel32" _
  (ByVal pDest As Long, ByVal pSource As Long, ByVal cbCopy As Long) ' see function Peek below

Sub ViewSize() ' main
    Dim swApp As SldWorks.SldWorks
    Set swApp = Application.SldWorks
    Dim doc As SldWorks.ModelDoc2
    Set doc = swApp.ActiveDoc
    Dim view As SldWorks.ModelView
    Set view = doc.ActiveView
    Call SetFrameSize(view, fh, fv)
End Sub

' works from SW2004. Before, ModelView::FrameHeight was only a Get property
Sub SetFrameSize(view As SldWorks.ModelView, fh As Long, fv As Long)
    view.FrameState = swWindowNormal
    Dim dib As Long
    dib = view.GetViewDIB
    Dim h As Long, v As Long
    h = Peek(dib + 4, vbLong)
    v = Peek(dib + 8, vbLong)
    view.FrameWidth = fh + view.FrameWidth - h
    view.FrameHeight = fv + view.FrameHeight - v
End Sub

Function Peek(Adresse As Long, VType As Long)
  Dim cbCopy As Long
  Select Case VType
    Case vbByte
      cbCopy = 1
    Case vbInteger, vbBoolean
      cbCopy = 2
    Case vbLong, vbSingle
      cbCopy = 4
    Case vbDouble
      cbCopy = 8
    Case Else
      Err.Raise 13
  End Select
  RtlMoveMemory VarPtr(Peek), VarPtr(VType), 4
  RtlMoveMemory VarPtr(Peek) + 8, Adresse, cbCopy
End Function

Filed under: VBA, assembly, drawing, macro, part   |  2 Comments