This example shows how to create a rectangular Viewport.
'-------------------------------------------------------------- 'Preconditions: ' 1. Create a VBA macro in a software product in which VBA is ' embedded. ' 2. Copy and paste this example into the Visual Basic IDE. ' 3. Add a reference to the DraftSight type library, ' install_dir\bin\dsAutomation.dll. ' 4. Start DraftSight. ' 5 Open the Immediate window. ' 6. Run the macro. ' ' Postconditions: ' 1. A Viewport is created on Sheet2. ' 2. Examine the drawing and output printed ' to the Immediate window. '----------------------------------------------------------------
Option Explicit
Sub main() Dim dsApp As DraftSight.Application Dim dsDoc As DraftSight.Document Dim SheetName as String Dim dsSheets As Variant Dim dsSheet As DraftSight.Sheet Dim index As Long Dim dsViewport As DraftSight.Viewport Dim dsMathUtility As DraftSight.MathUtility Dim startCorner As DraftSight.MathPoint Dim oppositeCorner As DraftSight.MathPoint Dim isClipped As Boolean
'Connect to DraftSight Set dsApp = GetObject(, "DraftSight.Application")
'Abort any command currently running in DraftSight 'to avoid nested commands dsApp.AbortRunningCommand
'Get active document Set dsDoc = dsApp.GetActiveDocument() If Not dsDoc Is Nothing Then
'Switch to Sheet space and activate Sheet2 dsSheets = dsDoc.GetSheets If IsArray(dsSheets) Then For index = LBound(dsSheets) To UBound(dsSheets) Set dsSheet = dsSheets(index) 'Get sheet name SheetName = dsSheet.Name 'Change sheet name, if it is not a model If SheetName <> "Model" Then 'Activate sheet dsSheet.Activate End If Next End If
' Set the corners for the Viewport Set dsMathUtility = dsApp.GetMathUtility Set startCorner = dsMathUtility.CreatePoint(0, 0, 0) Set oppositeCorner = dsMathUtility.CreatePoint(3, 3, 0)
'Create a rectangular Viewport Set dsViewport = dsSheet.InsertRectangularViewport(dsStandardViewports_1, False, startCorner, oppositeCorner)
' Activate and access the rectangular Viewport dsViewport.Active = True
Debug.Print (SheetName & ":") Debug.Print " Viewport:" dsViewport.GetIsClipped (isClipped) Debug.Print " Clipped by an entity? " & isClipped Debug.Print " Height: " & dsViewport.Height Debug.Print " Width: " & dsViewport.Width Debug.Print " Locked in model workspace? " & dsViewport.DisplayLocked Debug.Print " Displayed in graphics area? " & dsViewport.IsOn Debug.Print " Visible? " & dsViewport.Visible
Else Debug.Print "There are no open documents in DraftSight."
End If End Sub