[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