[Geomedia-l] Layout Automation

Matthias Lambracht m.lambracht at gmx.de
Fri Feb 16 02:30:29 CST 2007


Hello, 

I'm working with GeoMedia Professional 6.0 and I want to automate the layout
and add a Cartographic Grid programmatically. My code is running up to
oLWPlacementService.PlaceCartographicGrid(objSF). Then I had an error says
"Invalid map frame selected. Choose a valid map Smartframe."

 

Has anyone an idea to solve the problem? Thanks

 

Matthias

  

 

Private Sub PlaceGrid()

        Dim objGeoLayoutWindow As LayoutWindow

        Dim objLayoutView As Object

        Dim I As Long

        Dim objRect As PBasic.RectangleGeometry

        Dim objSheet As GMLayout.Sheet

        Dim objSF As GMLayout.SmartFrame2d

        Dim objSFs As GMLayout.SmartFrames2d

        Dim mapstring As String

 

        'Create Rectangle

        objRect = CreateObject("GeoMedia.RectangleGeometry")

        objRect.Origin.X = 330000

        objRect.Origin.Y = 990000

        objRect.Width = 1000

        objRect.Height = 1000

 

        objGeoLayoutWindow = Nothing

        'If the GeoWorkspace already contains a LayoutWindow,

        'set a pointer to it and to the LayoutView

        For I = 1 To gobjgeoapp.Windows.Count

            If gobjgeoapp.Windows(I).Type = "LayoutWindow" Then

                objGeoLayoutWindow = gobjgeoapp.Windows(I)

 

                Exit For

            End If

        Next I

        For I = 1 To gobjgeoapp.Windows.Count

            If gobjgeoapp.Windows(I).Type = "MapWindow" Then

gobjgeoapp.Windows(I).MapView.ZoomArea(objRect.Origin.X, objRect.Origin.Y,
0, objRect.Origin.X + objRect.Width, objRect.Origin.Y - objRect.Height, 0)

                  gobjgeoapp.Windows(I).MapView.Refresh()

                  Exit For

            End If

        Next I

 

        If Not objGeoLayoutWindow Is Nothing Then

            objLayoutView = objGeoLayoutWindow.LayoutView

            objGeoLayoutWindow.Visible = True

            objGeoLayoutWindow.Activate()

        Else

            'If the GeoWorkspace does not have a LayoutWindow, create one

            gobjgeoapp.Document.CreateLayoutWindow()

            For I = 1 To gobjgeoapp.Windows.Count

                If gobjgeoapp.Windows(I).Type = "LayoutWindow" Then

                    objGeoLayoutWindow = gobjgeoapp.Windows(I)

                    Exit For

                End If

            Next I

            If Not objGeoLayoutWindow Is Nothing Then

                objLayoutView = objGeoLayoutWindow.LayoutView

            End If

        End If

 

        'Import an existing layout template

        objLayoutView.Sheets.ImportLayout("\\...\...\GLT\A3.glt")   

 

        objSheet = objLayoutView.Sheets("A3")

        objSheet.Activate()

 

        Dim strFileName As String

        strFileName = gobjgeoapp.Path + "\OLE4DM.gws" 

 

        'Create a new SmartFrame style for the Map

        objLayoutView.SmartFrame2dStyles.Add("GMLayoutMapview", "")

        objSF = objSheet.SmartFrames2d.AddBy2Points("GMLayoutMapview ",
0.03, 0.03, 0.320, 0.280)

 

        Dim varMapScale As Double

        varMapScale = gobjgeoapp.Windows(I).MapView.DisplayScale

 

mapstring = "Map,MapWindow1,false," & objRect.Origin.X & "," &
objRect.Origin.Y - objRect.Height & "," & objRect.Origin.X + objRect.Width &
"," & objRect.Origin.Y - objRect.Height & "," & _

objRect.Origin.X + objRect.Width & "," & objRect.Origin.Y & "," &
objRect.Origin.X & "," &  objRect.Origin.Y & "," & varMapScale & ",0"

 

 

        objSF.CreateEmbed(strFileName, mapstring)

        objLayoutView.Fit()

 

 

        Dim oLWPlacementService As New
LWService.LayoutWindowPlacementService  

        Dim bSuccess As Boolean

        Dim sXML As String

 

        sXML = "\\...\...\XML\GridDefinition.xml"

 

        bSuccess =
oLWPlacementService.LoadCartographicGridDefinition(objGeoLayoutWindow.Layout
View, sXML)

 

        objSFs = objSheet.SmartFrames2d

        For I = 1 To objSFs.Count

            objSF = objSFs(I)

            If objSF.Style.Name = "GMLayoutMapview" Then

                oLWPlacementService.PlaceCartographicGrid(objSF)

                If Err.Number > 0 Then _

                MsgBox(Err.Description)

            End If

        Next I

 

End Sub

-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.directionsmedia.net/pipermail/geomedia-l/attachments/20070216/e477f48f/attachment.html


More information about the GeoMedia-l mailing list