Results 1 to 1 of 1

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

  1. #1

    Thread Starter
    Super Moderator RobDog888's Avatar
    Join Date
    Apr 2001
    Location
    LA, Calif. Raiders #1 AKA:Gangsta Yoda™
    Posts
    60,713

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

    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:

    VB Code:
    1. Option Explicit
    2. 'Add a reference to MS Visio xx.0 Object Library
    3. Private Sub Command1_Click()
    4.    
    5.     Dim oApp As Visio.Application
    6.     Dim oVsd As Visio.Document
    7.     Dim oVsp As Visio.Page
    8.     Dim oShp1 As Visio.Shape
    9.     Dim YCell As Visio.Cell
    10.     Dim XCell As Visio.Cell
    11.  
    12.     Set oApp = New Visio.Application
    13.     Set oVsd = oApp.Documents.Open("C:\Development\Tips\Visio FAQ - AddModify Shapes\Drawing1.vsd")
    14.     oApp.Visible = True
    15.     Set oVsp = oVsd.Pages.Item(1)
    16.     Set oShp1 = oVsp.Import("C:\Dog1.gif")
    17.    
    18.     'Show the grid if its a drawing
    19.     If oApp.Application.ActiveWindow.Type = visDrawing Then
    20.         oApp.Application.ActiveWindow.ShowGrid = True
    21.     Else
    22.         'Tell the user why you're not showing the grid.
    23.         MsgBox "Current window is not a drawing window.", vbOKOnly
    24.     End If
    25.    
    26.     oVsp.Drop oShp1, 2, 5.5 'Drop shape on page at position 2, 5.5
    27.     oShp1.Delete 'Remove original imported reference
    28.     Set oShp1 = oVsp.Shapes(1) 'Re-Set object to dropped shape
    29.  
    30.     'Set coordinate system to center of page (Cartesian)
    31.     oShp1.Cells("BeginX") = 0
    32.     oShp1.Cells("EndX") = 0
    33.     oShp1.Cells("BeginY") = 0
    34.     oShp1.Cells("EndY") = 0
    35.  
    36.     'Setting the picture cell object vars
    37.     Set YCell = oShp1.Cells("PinY")
    38.     Set XCell = oShp1.Cells("PinX")
    39.  
    40.     'Setting the center of the picture to coordinate location...
    41.     XCell.Formula = 4 'Or where ever (Inches)
    42.     YCell.Formula = 4 'Or where ever (Inches)
    43.  
    44.     'Stretch image
    45.     oShp1.Cells("Width") = 5 'Unit is Inches
    46.     oShp1.Cells("Height") = 3.5 'Unit is Inches
    47.    
    48.     'Clean up object variables:
    49.     Set YCell = Nothing
    50.     Set XCell = Nothing
    51.     Set oShp1 = Nothing
    52.     Set oVsp = Nothing
    53.     'If you want to close the document, else comment the next line.
    54.     oVsd.Close
    55.     Set oVsd = Nothing
    56.     'If you want to close the application, else comment the next line.
    57.     oApp.Quit
    58.     Set oApp = Nothing
    59.  
    60. End Sub
    Last edited by RobDog888; Aug 23rd, 2006 at 03:38 PM.
    VB/Office Guru™ (AKA: Gangsta Yoda®)
    I dont answer coding questions via PM. Please post a thread in the appropriate forum.

    Microsoft MVP 2006-2011
    Office Development FAQ (C#, VB.NET, VB 6, VBA)
    Senior Jedi Software Engineer MCP (VB 6 & .NET), BSEE, CET
    If a post has helped you then Please Rate it!
    Reps & Rating PostsVS.NET on Vista Multiple .NET Framework Versions Office Primary Interop AssembliesVB/Office Guru™ Word SpellChecker™.NETVB/Office Guru™ Word SpellChecker™ VB6VB.NET Attributes Ex.Outlook Global Address ListAPI Viewer utility.NET API Viewer Utility
    System: Intel i7 6850K, Geforce GTX1060, Samsung M.2 1 TB & SATA 500 GB, 32 GBs DDR4 3300 Quad Channel RAM, 2 Viewsonic 24" LCDs, Windows 10, Office 2016, VS 2019, VB6 SP6

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width