[FAQ's: OD] How do I add/modify Shapes to a drawing?

[RobDog888]

By automating the importing or modification of shapes of your drawing you can easily save time vs. manually adding objects and modifying them. For example, if you have data in a database that you would like to populate a drawing with (graphic or textual data) you can automate the process to save time and effort.


This example below shows how to add a image from a file on the local system and position and resize it. A Visio Shape object is anything you can select in a drawing window: a basic shape, a group, a guide, or an object so it doesnt necessarily only have to be for an image.


Visio 2003 And VB 6 Code Example:

Option Explicit
'Add a reference to MS Visio xx.0 Object Library
Private Sub Command1_Click()
    
    Dim oApp As Visio.Application
    Dim oVsd As Visio.Document
    Dim oVsp As Visio.Page
    Dim oShp1 As Visio.Shape
    Dim YCell As Visio.Cell
    Dim XCell As Visio.Cell
 
    Set oApp = New Visio.Application
    Set oVsd = oApp.Documents.Open("C:\Development\Tips\Visio FAQ - AddModify Shapes\Drawing1.vsd")
    oApp.Visible = True
    Set oVsp = oVsd.Pages.Item(1)
    Set oShp1 = oVsp.Import("C:\Dog1.gif")
    
    'Show the grid if its a drawing
    If oApp.Application.ActiveWindow.Type = visDrawing Then
        oApp.Application.ActiveWindow.ShowGrid = True
    Else
        'Tell the user why you're not showing the grid.
        MsgBox "Current window is not a drawing window.", vbOKOnly
    End If
    
    oVsp.Drop oShp1, 2, 5.5 'Drop shape on page at position 2, 5.5
    oShp1.Delete 'Remove original imported reference
    Set oShp1 = oVsp.Shapes(1) 'Re-Set object to dropped shape
 
    'Set coordinate system to center of page (Cartesian)
    oShp1.Cells("BeginX") = 0
    oShp1.Cells("EndX") = 0
    oShp1.Cells("BeginY") = 0
    oShp1.Cells("EndY") = 0
 
    'Setting the picture cell object vars
    Set YCell = oShp1.Cells("PinY")
    Set XCell = oShp1.Cells("PinX")
 
    'Setting the center of the picture to coordinate location...
    XCell.Formula = 4 'Or where ever (Inches)
    YCell.Formula = 4 'Or where ever (Inches)
 
    'Stretch image
    oShp1.Cells("Width") = 5 'Unit is Inches
    oShp1.Cells("Height") = 3.5 'Unit is Inches
    
    'Clean up object variables:
    Set YCell = Nothing
    Set XCell = Nothing
    Set oShp1 = Nothing
    Set oVsp = Nothing
    'If you want to close the document, else comment the next line.
    oVsd.Close
    Set oVsd = Nothing
    'If you want to close the application, else comment the next line.
    oApp.Quit
    Set oApp = Nothing
 
End Sub