Sub main excelPath = "C:\Manifold_WaterFlood_input.xls" ExportPath = "" Paper="Ledger" Landscape="False" 'or "True" set fs = CreateObject("Scripting.FileSystemObject") if not fs.FileExists(excelPath) then Application.messagebox "check!! This file C:\Manifold_WaterFlood_input.xls does not exist" exit sub End If Set DS = Document.NewDataSource DS.ConnectionType = "XLS" DS.ConnectionString = excelPath 'GridAlignOnly_Flag=False 'If Application.MessageBoxEx ("Do you want to only align the grid (no other map)?", "This should be quick" , MessageBoxTypeYesNo) = MessageBoxResultYes Then ' GridAlignOnly_Flag=true 'End If 'If GridAlignOnly_Flag=False Then 'Test for cumulatives If DS.Probe Then Set objExcel = CreateObject("Excel.Application") objExcel.DisplayAlerts = 0 objExcel.Workbooks.open excelPath, false, true '---Well Locations DS.ImportTable "Output_Well_Manifold" & "$" Set Comps=Document.ComponentSet Set Comp = Comps(Comps.count-1) comp.name = "WellLocations_Table_Temp" End If Set Records=Comp.recordset CumOP_new=0 CumWP_new=0 CumWP_new=0 for i=0 to records.count-1 CumOP_new=CumOP_new+Records(i).data("CumOil,m3") CumWP_new=CumWP_new+Records(i).data("CumWater,m3") CumWI_new=CumWI_new+Records(i).data("CumWaterInjection,m3") Next Document.ComponentSet.Remove("WellLocations_Table_Temp") ' Remove existing Drawing and Tables 'Cum Bubbles Exists BubbleExist=False ' check to see if bubbles already exists If Document.ComponentSet.ItemByName("WellLocations_Table_Wells_WI")<> -1 Then ' It does exist If Document.ComponentSet.ItemByName("WellLocations_Table_Wells_WP")<> -1 Then ' It does exist If Document.ComponentSet.ItemByName("WellLocations_Table_Wells_OP")<> -1 Then ' It does exist BubbleExist=True End If End If End If KeepBubbles_Flag=False If BubbleExist=True Then Set comp=Document.ComponentSet("WellLocations_Table") Set Records=Comp.recordset CumOP_old=0 CumWP_old=0 CumWP_old=0 for i=0 to records.count-1 CumOP_old=CumOP_old+Records(i).data("CumOil,m3") CumWP_old=CumWP_old+Records(i).data("CumWater,m3") CumWI_old=CumWI_old+Records(i).data("CumWaterInjection,m3") Next If (CumOP_old+CumWP_old+CumWI_old)=(CumOP_New+CumWP_new+CumWI_new) Then If Application.MessageBoxEx ("Do you want to keep existing well and cum bubble drawings", "Cum Bubbles Drawings Exist!!" , MessageBoxTypeYesNo) = MessageBoxResultYes Then KeepBubbles_Flag=true End If End If End If i=0 ExitFlag=False delete_flag=false Do If Document.ComponentSet(i).Type=Componentfolder Then set fold=Document.ComponentSet(i) For each child in fold.children If (child.Type<>ComponentScript and Instr(child.Name,"WellLocations")=0) or (Instr(child.Name,"WellLocations")>0 and KeepBubbles_Flag=False) then Document.ComponentSet.Remove(child.name) delete_flag=true End If Next End If If KeepBubbles_Flag=False Then ExitFlag=true for each comp in Document.Componentset If comp.type<>componentScript and comp.type<>componentFolder then ExitFlag=false Next Else ExitFlag=true for each comp in Document.Componentset If comp.type<>componentScript and Instr(Document.ComponentSet(i).Name,"WellLocations")=0 Then ExitFlag=false Next End If if delete_flag=false then i=i+1 delete_flag=false Loop until ExitFlag 'End If ' GridAlignOnly_Flag=False If Document.ComponentSet.ItemByName("Drawings")= -1 Then ' It does not exist Set F_drawings=Document.NewFolder("Drawings") Else Set F_drawings=Document.ComponentSet("Drawings") End If If Document.ComponentSet.ItemByName("Maps")= -1 Then ' It does not exist Set F_maps=Document.newFolder("Maps") Else Set F_maps=Document.ComponentSet("Maps") End If If Document.ComponentSet.ItemByName("Tables")= -1 Then ' It does not exist Set F_Tables=Document.NewFolder("Tables") Else Set F_Tables=Document.ComponentSet("Tables") End If If DS.Probe Then Set objExcel = CreateObject("Excel.Application") objExcel.DisplayAlerts = 0 objExcel.Workbooks.open excelPath, false, true '---Well Locations If KeepBubbles_Flag=False Then If Document.ComponentSet.ItemByName("WellLocations_Table")<> -1 Then ' It does exist Document.ComponentSet.Remove("WellLocations_Table") End If DS.ImportTable "Output_Well_Manifold" & "$" Set Comps=Document.ComponentSet Set Comp = Comps(Comps.count-1) comp.name = "WellLocations_Table" comp.folder=F_Tables End If '---Boundary DS.ImportTable "Input_NetBoundary" & "$" If Document.ComponentSet.ItemByName("Boundary_Table")<> -1 Then ' It does exist Document.ComponentSet.Remove("Boundary_Table") End If Set Comps=Document.ComponentSet Set Comp = Comps(Comps.count-1) comp.name = "Boundary_Table" comp.folder=F_Tables Set Records=comp.Recordset '---Draw polygon NewDrawingName=comp.Name + "_Polygon" If Document.ComponentSet.ItemByName(NewDrawingName)<> -1 Then ' It does exist Document.ComponentSet.Remove(NewDrawingName) End If set Drwg = document.NewDrawing(NewDrawingName) Drwg.folder=F_Drawings If Records.count>3 then i=1 Do If i>Records.count or Records(i-1).Data("X")=0 then exit do Set Record_i=Records(i-1) LineID_i=Record_i.Data("LineID") LineID_ip1=LineID_i Set pointSet = Application.NewPointSet Do While LineID_i=LineID_ip1 Set point = Application.NewPoint Point.X = CDbl(Record_i.Data("X")) Point.Y = CDbl(Record_i.Data("Y")) pointSet.Add point If i=Records.Count Then i=i+1 Exit do End If i=i+1 Set Record_ip1=Records(i-1) LineID_ip1=Record_ip1.Data("LineID") Set Record_i=Record_ip1 Loop ' To make Polygon Set geom = Application.NewGeom(GeomLine, pointSet) Set ObjSet = drwg.ObjectSet ObjSet.Add geom Loop until False End If '--- Box Locations and attributes DS.ImportTable "Output_Box_Manifold" & "$" If Document.ComponentSet.ItemByName("BoxLocations_Table")<> -1 Then ' It does exist Document.ComponentSet.Remove("BoxLocations_Table") End If Set Comps=Document.ComponentSet Set Comp = Comps(Comps.count-1) comp.name = "BoxLocations_Table" comp.folder=F_Tables Set Records=comp.Recordset NewDrawingName=comp.Name + "_Boxes" If Document.ComponentSet.ItemByName(NewDrawingName)<> -1 Then ' It does exist Document.ComponentSet.Remove(NewDrawingName) End If set Drwg = document.NewDrawing(NewDrawingName) Drwg.folder=F_Drawings Set Drwgtable=drwg.ownedTable Set col=Drwgtable.columnset.NewColumn col.name="BoxID" 'col.type=ColumnTypeInt32U Drwgtable.Columnset.add(col) Set col=Drwgtable.columnset.NewColumn col.name="PVInj%" col.type=ColumnTypeFloat64 Drwgtable.Columnset.add(col) Set col=Drwgtable.columnset.NewColumn col.name="RF%" col.type=ColumnTypeFloat64 Drwgtable.Columnset.add(col) Set col=Drwgtable.columnset.NewColumn col.name="HPV,rm3" col.type=ColumnTypeFloat64 Drwgtable.Columnset.add(col) '-- Set col=Drwgtable.columnset.NewColumn col.name="HPV,MMrm3" col.type=ColumnTypeFloat64 Drwgtable.Columnset.add(col) '-- Set col=Drwgtable.columnset.NewColumn col.name="OOIP,m3" col.type=ColumnTypeFloat64 Drwgtable.Columnset.add(col) Set col=Drwgtable.columnset.NewColumn col.name="OOIP,MMm3" col.type=ColumnTypeFloat64 Drwgtable.Columnset.add(col) '-- Set col=Drwgtable.columnset.NewColumn col.name="OilProdStartDate" 'col.type=7 'Date Drwgtable.Columnset.add(col) '-- Set col=Drwgtable.columnset.NewColumn col.name="WaterProdStartDate" 'col.type=7 'Date Drwgtable.Columnset.add(col) '-- Set col=Drwgtable.columnset.NewColumn col.name="WaterInjStartDate" 'col.type=7 ' Date Drwgtable.Columnset.add(col) Set col=Drwgtable.columnset.NewColumn col.name="OilProdStartYear" col.type=ColumnTypeInt32U Drwgtable.Columnset.add(col) Set col=Drwgtable.columnset.NewColumn col.name="WaterProdStartYear" col.type=ColumnTypeInt32U Drwgtable.Columnset.add(col) Set col=Drwgtable.columnset.NewColumn col.name="WaterInjStartYear" col.type=ColumnTypeInt32U Drwgtable.Columnset.add(col) '-- Set col=Drwgtable.columnset.NewColumn col.name="Net2GrossArea,%" col.type=ColumnTypeFloat64 Drwgtable.Columnset.add(col) '- Set col=Drwgtable.columnset.NewColumn col.name="VoidageRep%" col.type=ColumnTypeFloat64 Drwgtable.Columnset.add(col) '--- Set col=Drwgtable.columnset.NewColumn col.name="KH,mdm" col.type=ColumnTypeFloat64 Drwgtable.Columnset.add(col) '--- Set col=Drwgtable.columnset.NewColumn col.name="K,md" col.type=ColumnTypeFloat64 Drwgtable.Columnset.add(col) '--- Set col=Drwgtable.columnset.NewColumn col.name="Porosity,%" col.type=ColumnTypeFloat64 Drwgtable.Columnset.add(col) '--- Set col=Drwgtable.columnset.NewColumn col.name="So,%" col.type=ColumnTypeFloat64 Drwgtable.Columnset.add(col) '--- Set col=Drwgtable.columnset.NewColumn col.name="Thickness,m" col.type=ColumnTypeFloat64 Drwgtable.Columnset.add(col) '--- Set col=Drwgtable.columnset.NewColumn col.name="WellSpacing,m" col.type=ColumnTypeFloat64 Drwgtable.Columnset.add(col) i=1 Do If i>Records.count then exit do Set Record_i=Records(i-1) LineID_i=Record_i.Data("BoxID") LineID_ip1=LineID_i Set pointSet = Application.NewPointSet Do While LineID_i=LineID_ip1 Set point = Application.NewPoint Point.X = CDbl(Record_i.Data("X")) Point.Y = CDbl(Record_i.Data("Y")) pointSet.Add point If i=Records.Count Then i=i+1 Exit do End If i=i+1 Set Record_ip1=Records(i-1) LineID_ip1=Record_ip1.Data("BoxID") Set Record_i=Record_ip1 Loop ' To make Area Set geom = Application.NewGeom(GeomArea, pointSet) Set ObjSet = drwg.ObjectSet ObjSet.Add geom ObjSet.LastAdded.Record.Data("BoxID") = Records(i-2).Data("BoxID") ObjSet.LastAdded.Record.Data("PVInj%") = Records(i-2).Data("PVInj%") ObjSet.LastAdded.Record.Data("RF%") = Records(i-2).Data("RF%") ObjSet.LastAdded.Record.Data("HPV,rm3") = Records(i-2).Data("HPV,rm3") ObjSet.LastAdded.Record.Data("HPV,MMrm3") = Records(i-2).Data("HPV,rm3")/1000000 ObjSet.LastAdded.Record.Data("OOIP,m3") = Records(i-2).Data("OOIP,m3") ObjSet.LastAdded.Record.Data("OOIP,MMm3") = Records(i-2).Data("OOIP,m3")/1000000 ObjSet.LastAdded.Record.Data("OilProdStartDate") = Records(i-2).Data("OilProdStartDate") ObjSet.LastAdded.Record.Data("WaterProdStartDate") = Records(i-2).Data("WaterProdStartDate") ObjSet.LastAdded.Record.Data("WaterInjStartDate") = Records(i-2).Data("WaterInjStartDate") ObjSet.LastAdded.Record.Data("OilProdStartYear") = Records(i-2).Data("OilProdStartYear") ObjSet.LastAdded.Record.Data("WaterProdStartYear") = Records(i-2).Data("WaterProdStartYear") ObjSet.LastAdded.Record.Data("WaterInjStartYear") = Records(i-2).Data("WaterInjStartYear") '-- ObjSet.LastAdded.Record.Data("Net2GrossArea,%") = Records(i-2).Data("Net2GrossArea,%") ObjSet.LastAdded.Record.Data("VoidageRep%") = Records(i-2).Data("VoidageRep%") ObjSet.LastAdded.Record.Data("KH,mdm") = Records(i-2).Data("KH,mdm") '--- ObjSet.LastAdded.Record.Data("K,md") = Records(i-2).Data("K,md") ObjSet.LastAdded.Record.Data("Porosity,%") = Records(i-2).Data("Porosity,%") ObjSet.LastAdded.Record.Data("So,%") = Records(i-2).Data("So,%") ObjSet.LastAdded.Record.Data("Thickness,m") = Records(i-2).Data("Thickness,m") ObjSet.LastAdded.Record.Data("WellSpacing,m") = Records(i-2).Data("WellSpacing,m") Loop until False Drwg.AreaForeground.Set(Application.NewColor("Grey",128,128,128)) Drwg.AreaBackground.Set(Application.NewColor("White",255,255,255)) Drwg.folder=F_Drawings 'Make Well Drawings If KeepBubbles_Flag=False Then set Tbl=Document.ComponentSet("WellLocations_Table") If Document.ComponentSet.ItemByName(Tbl.Name & " 2")<> -1 Then ' It does exist Document.ComponentSet.Remove(Tbl.Name & " 2") End If Tbl.Copy False Delay 2.5, True Set UI = Application.UserInterface UI.InvokeCommand "ViewProjectPasteAsDrawing", "Pane:Project" Do ' Nothing Loop Until ui.DisplaysModalDialog Set dlg = ui.ModalDialog With Dlg.ControlSet .Item("ComboBoxX").Text = "X" .Item("ComboBoxY").Text = "Y" .Item("CheckBoxLatitudeLongitudeCoordinates").Checked = False .Item("ButtonOK").Push End With Drwgname=Tbl.Name & "_Wells" If Document.ComponentSet.ItemByName(Drwgname)<> -1 Then ' It does exist Document.ComponentSet.Remove(Drwgname) End If Set Drwg = Document.ComponentSet(Tbl.Name & " 2") Drwg.Name = Drwgname Drwg.folder=F_Drawings Drwg.OwnedTable.Name = Drwgname & " Table" Drwg.PointForeground.Set(Application.NewColor("black",0,0,0)) Drwg.PointBackground.Set(Application.NewColor("black",0,0,0)) Drwg.PointSize.set(cLng(1)) ' The same can be used for LineSize lblname=Drwg.Name + "_NameLabel" Set lbl=Document.NewLabels(lblname,Drwg) Set DrwgTable=Drwg.OwnedTable Set Cols= DrwgTable.columnset lbl.Text = "[Well]" lbl.Synchronized = False lbl.Synchronized = True lbl.perlabelformat=true lbl.optimizelabelalignx = false lbl.optimizelabelaligny = false lbl.LabelAlignY=LabelAlignYTop 'LabelAlignYCenter .... lbl.pointoffsetx=0 lbl.pointoffsety=1 lbl.resolveoverlaps = false lbl.fontface = "Arial" lbl.LabelSize.DefaultValue.formatting = 6 End If 'Make a drawing with Wells by Injector and Producer Set Welldrwg=Document.Componentset("WellLocations_Table_Wells") Welldrwg.copy false Delay 2.5, True Document.Paste Set drwg=Document.Componentset.Item(Document.Componentset.count-2) If Document.ComponentSet.ItemByName("BoxLocations_Table_Boxes_GridAlign")<> -1 Then ' It does exist Document.ComponentSet.Remove("BoxLocations_Table_Boxes_GridAlign") End If drwg.name="BoxLocations_Table_Boxes_GridAlign" Drwg.OwnedTable.Name = drwg.name & " Table" Set Drwgtable = Drwg.OwnedTable Set col=Drwgtable.columnset.NewColumn col.name="WellType" 'col.type=ColumnTypeInt32U Drwgtable.Columnset.add(col) Set Records=Drwgtable.Recordset ii=1 Do If ii>Records.count then exit do Set Record_i=Records(ii-1) WI=Record_i.Data("CumWaterInjection,m3") If WI>0 Then Record_i.Data("WellType")="Injector" Else Record_i.Data("WellType")="Producer" End If ii=ii+1 Loop Drwg.folder=F_Drawings Drwg.PointSize.set(cLng(3)) ' The same can be used for LineSize 'Drwg.PointBackground.Set(Application.NewColor("blue",0,0,255)) drwg.Open Set ui = Application.UserInterface ui.Toolbars.Item("Format").ControlSet.Item("EditFormatPointBackground").PushNamed("Theme") Do ' Nothing Loop Until ui.DisplaysModalDialog Set dlg = ui.ModalDialog With dlg.ControlSet .Item("CheckBoxPreview").Checked = True .Item("ComboBoxColumn").Text = "WellType" .Item("ComboBoxMethod").Text = "Uniques Values" .Item("ComboBoxPalette").Text = "Blues to Greens" .Item("EditFormatApply").Push '.Item("EditFormatReverse").Push .Item("ButtonOK").Push End With ' Turn on the legend UI.invokeCommand("ViewLegend") set dlg = UI.ModalDialog dlg.ControlSet("CheckBoxShow").Checked = True dlg.accept 'If GridAlignOnly_Flag=True Then ' Set drwg=Document.ComponentSet("WellLocations_Table_Wells_GridAlign") ' If Document.ComponentSet.ItemByName(drwg.Name & "_map")<> -1 Then ' It does exist ' Document.ComponentSet.Remove(drwg.Name & "_map") ' End If ' Set NewMap=Document.NewMap("TempMap",drwg) ' NewMap.Name="WellLocations_Table_Boxes_GridAlign" & "_map" ''--- ' If Document.ComponentSet.ItemByName("Boundary_Table_Polygon")<> -1 Then ' It does exist ' Set drwg=Document.componentSet("Boundary_Table_Polygon") ' Set Layer=Document.NewLayer(drwg) ' NewMap.LayerSet.Add (Layer) ' NewMap.Layerset.Item(0).order = NewMap.Layerset.Count -1 ' Send it to the very first ' End If ' If Document.ComponentSet.ItemByName("BoxLocations_Table_Boxes")<> -1 Then ' It does exist ' Set drwg=Document.componentSet("BoxLocations_Table_Boxes") ' Set Layer=Document.NewLayer(drwg) ' NewMap.LayerSet.Add (Layer) ' NewMap.Layerset.Item(0).order = NewMap.Layerset.Count -1 ' Send it to the very first ' End If ' NewMap.Folder=F_Maps ' 'Legend ' NewMap.open ' UI.invokeCommand("ViewLegend") ' set dlg = UI.ModalDialog ' dlg.ControlSet("CheckBoxShow").Checked = True ' dlg.accept '' Create Layout ' set Lay=Document.NewLayout(NewMap.Name & "_Layout", NewMap) 'ExportTheMap ' set UI = Application.userInterface ' set doc = Application.activeDocument ' set theWindowSet = Application.windowSet ' theWindowSet.close() ' set thelog = Application.History ' Lay.open() ' UI.invokecommand "FilePageSetup" ' set dlg = UI.modaldialog ' dlg.ControlSet("ComboBox0").Text = Paper ' If Landscape="True" Then ' dlg.ControlSet("ButtonLandscape").Checked = True ' Else ' dlg.ControlSet("ButtonLandscape").Checked = false ' End If ' dlg.accept ' ' set oExportPDF = Application.NewExport("PDF") ' oExportPDF.Compression = False ' oExportPDF.Resolution = 300 ' oExportPDF.VectorResolution = 72 ' oExportPDF.Transparency = True ' oExportPDF.Export Lay, ExportPath & Mid(NewMap.Name,Instr(NewMap.Name,"Boxes_"),len(NewMap.Name)-Instr(NewMap.Name,"Boxes_")+1) & ".pdf", PromptNone 'End If 'If GridAlignOnly_Flag=False Then 'Now Copy Drawings to make The needed for maps 'Delay 5, True Set Boxdrwg=Document.Componentset("BoxLocations_Table_Boxes") 'Make PVInj Drawing If Document.ComponentSet.ItemByName(BoxDrwg.name & " 2")<> -1 Then ' It does exist Document.ComponentSet.Remove(BoxDrwg.name & " 2") End If Boxdrwg.copy false Delay 2.5, True Document.Paste Set drwg=Document.Componentset(BoxDrwg.name & " 2") drwg.name=BoxDrwg.name & "_PVInj" Set DrwgTable=Drwg.OwnedTable DrwgTable.name=drwg.name & " Table" ' Color PVInj% drwg.Open Set ui = Application.UserInterface ui.Toolbars.Item("Format").ControlSet.Item("EditFormatAreaBackground").PushNamed("Theme") Do ' Nothing Loop Until ui.DisplaysModalDialog Set dlg = ui.ModalDialog With dlg.ControlSet .Item("CheckBoxPreview").Checked = True .Item("ComboBoxColumn").Text = "PVInj%" .Item("ComboBoxMethod").Text = "Natural Breaks" .Item("ComboBoxPalette").Text = "Blues to Greens" .Item("EditFormatApply").Push .Item("EditFormatReverse").Push .Item("ButtonOK").Push End With ' Turn on the legend UI.invokeCommand("ViewLegend") set dlg = UI.ModalDialog dlg.ControlSet("CheckBoxShow").Checked = True dlg.accept Drwg.folder=F_Drawings 'Delay 5, True 'Make HPV If Document.ComponentSet.ItemByName(BoxDrwg.name & " 2")<> -1 Then ' It does exist Document.ComponentSet.Remove(BoxDrwg.name & " 2") End If Boxdrwg.copy false Delay 2.5, True Document.Paste Set drwg=Document.Componentset(BoxDrwg.name & " 2") drwg.name=BoxDrwg.name & "_HPV,MMrm3" Set DrwgTable=Drwg.OwnedTable DrwgTable.name=drwg.name & " Table" ' Color HPV% drwg.Open Set ui = Application.UserInterface ui.Toolbars.Item("Format").ControlSet.Item("EditFormatAreaBackground").PushNamed("Theme") Do ' Nothing Loop Until ui.DisplaysModalDialog Set dlg = ui.ModalDialog With dlg.ControlSet .Item("CheckBoxPreview").Checked = True .Item("ComboBoxColumn").Text = "HPV,MMrm3" .Item("ComboBoxMethod").Text = "Natural Breaks" .Item("ComboBoxPalette").Text = "Blues to Greens" .Item("EditFormatApply").Push '.Item("EditFormatReverse").Push .Item("ButtonOK").Push End With ' Turn on the legend UI.invokeCommand("ViewLegend") set dlg = UI.ModalDialog dlg.ControlSet("CheckBoxShow").Checked = True dlg.accept Drwg.folder=F_Drawings 'Delay 5, True 'Make RF% If Document.ComponentSet.ItemByName(BoxDrwg.name & " 2")<> -1 Then ' It does exist Document.ComponentSet.Remove(BoxDrwg.name & " 2") End If Boxdrwg.copy false Delay 2.5, True Document.Paste Set drwg=Document.Componentset(BoxDrwg.name & " 2") drwg.name=BoxDrwg.name & "_RF" Set DrwgTable=Drwg.OwnedTable DrwgTable.name=drwg.name & " Table" ' Color RF% drwg.Open Set ui = Application.UserInterface ui.Toolbars.Item("Format").ControlSet.Item("EditFormatAreaBackground").PushNamed("Theme") Do ' Nothing Loop Until ui.DisplaysModalDialog Set dlg = ui.ModalDialog With dlg.ControlSet .Item("CheckBoxPreview").Checked = True .Item("ComboBoxColumn").Text = "RF%" .Item("ComboBoxMethod").Text = "Natural Breaks" .Item("ComboBoxPalette").Text = "Greens and Reds" .Item("EditFormatApply").Push '.Item("EditFormatReverse").Push .Item("ButtonOK").Push End With ' Turn on the legend UI.invokeCommand("ViewLegend") set dlg = UI.ModalDialog dlg.ControlSet("CheckBoxShow").Checked = True dlg.accept Drwg.folder=F_Drawings 'Delay 5, True 'Make ProdStartYear% If Document.ComponentSet.ItemByName(BoxDrwg.name & " 2")<> -1 Then ' It does exist Document.ComponentSet.Remove(BoxDrwg.name & " 2") End If Boxdrwg.copy false Delay 2.5, True Document.Paste Set drwg=Document.Componentset(BoxDrwg.name & " 2") drwg.name=BoxDrwg.name & "_ProdStartYear" Set DrwgTable=Drwg.OwnedTable DrwgTable.name=drwg.name & " Table" ' Color ProdStartYear% drwg.Open Set ui = Application.UserInterface ui.Toolbars.Item("Format").ControlSet.Item("EditFormatAreaBackground").PushNamed("Theme") Do ' Nothing Loop Until ui.DisplaysModalDialog Set dlg = ui.ModalDialog With dlg.ControlSet .Item("CheckBoxPreview").Checked = True .Item("ComboBoxColumn").Text = "OilProdStartYear" .Item("ComboBoxMethod").Text = "Natural Breaks" .Item("ComboBoxPalette").Text = "Temperature" .Item("EditFormatApply").Push '.Item("EditFormatReverse").Push .Item("ButtonOK").Push End With ' Turn on the legend UI.invokeCommand("ViewLegend") set dlg = UI.ModalDialog dlg.ControlSet("CheckBoxShow").Checked = True dlg.accept Drwg.folder=F_Drawings 'Delay 5, True 'Make InjStartYear% If Document.ComponentSet.ItemByName(BoxDrwg.name & " 2")<> -1 Then ' It does exist Document.ComponentSet.Remove(BoxDrwg.name & " 2") End If Boxdrwg.copy false Delay 2.5, True Document.Paste Set drwg=Document.Componentset(BoxDrwg.name & " 2") drwg.name=BoxDrwg.name & "_InjStartYear" Set DrwgTable=Drwg.OwnedTable DrwgTable.name=drwg.name & " Table" ' Color InjStartYear% drwg.Open Set ui = Application.UserInterface ui.Toolbars.Item("Format").ControlSet.Item("EditFormatAreaBackground").PushNamed("Theme") Do ' Nothing Loop Until ui.DisplaysModalDialog Set dlg = ui.ModalDialog With dlg.ControlSet .Item("CheckBoxPreview").Checked = True .Item("ComboBoxColumn").Text = "WaterInjStartYear" .Item("ComboBoxMethod").Text = "Natural Breaks" .Item("ComboBoxPalette").Text = "Temperature" .Item("EditFormatApply").Push '.Item("EditFormatReverse").Push .Item("ButtonOK").Push End With ' Turn on the legend UI.invokeCommand("ViewLegend") set dlg = UI.ModalDialog dlg.ControlSet("CheckBoxShow").Checked = True dlg.accept Drwg.folder=F_Drawings 'Delay 5, True '-- Make Net2Gross Area If Document.ComponentSet.ItemByName(BoxDrwg.name & " 2")<> -1 Then ' It does exist Document.ComponentSet.Remove(BoxDrwg.name & " 2") End If Boxdrwg.copy false Delay 2.5, True Document.Paste Set drwg=Document.Componentset(BoxDrwg.name & " 2") drwg.name=BoxDrwg.name & "_Net2GrossArea" Set DrwgTable=Drwg.OwnedTable DrwgTable.name=drwg.name & " Table" ' Color InjStartYear% drwg.Open Set ui = Application.UserInterface ui.Toolbars.Item("Format").ControlSet.Item("EditFormatAreaBackground").PushNamed("Theme") Do ' Nothing Loop Until ui.DisplaysModalDialog Set dlg = ui.ModalDialog With dlg.ControlSet .Item("CheckBoxPreview").Checked = True .Item("ComboBoxColumn").Text = "Net2GrossArea,%" .Item("ComboBoxMethod").Text = "Natural Breaks" .Item("ComboBoxPalette").Text = "Temperature" .Item("EditFormatApply").Push '.Item("EditFormatReverse").Push .Item("ButtonOK").Push End With ' Turn on the legend UI.invokeCommand("ViewLegend") set dlg = UI.ModalDialog dlg.ControlSet("CheckBoxShow").Checked = True dlg.accept Drwg.folder=F_Drawings '=== 'Delay 5, True '-- Make VoidageRep% If Document.ComponentSet.ItemByName(BoxDrwg.name & " 2")<> -1 Then ' It does exist Document.ComponentSet.Remove(BoxDrwg.name & " 2") End If Boxdrwg.copy false Delay 2.5, True Document.Paste Set drwg=Document.Componentset(BoxDrwg.name & " 2") drwg.name=BoxDrwg.name & "_VoidageRep" Set DrwgTable=Drwg.OwnedTable DrwgTable.name=drwg.name & " Table" ' Color InjStartYear% drwg.Open Set ui = Application.UserInterface ui.Toolbars.Item("Format").ControlSet.Item("EditFormatAreaBackground").PushNamed("Theme") Do ' Nothing Loop Until ui.DisplaysModalDialog Set dlg = ui.ModalDialog With dlg.ControlSet .Item("CheckBoxPreview").Checked = True .Item("ComboBoxColumn").Text = "VoidageRep%" .Item("ComboBoxMethod").Text = "Natural Breaks" .Item("ComboBoxPalette").Text = "Temperature" .Item("EditFormatApply").Push '.Item("EditFormatReverse").Push .Item("ButtonOK").Push End With ' Turn on the legend UI.invokeCommand("ViewLegend") set dlg = UI.ModalDialog dlg.ControlSet("CheckBoxShow").Checked = True dlg.accept Drwg.folder=F_Drawings '=== 'Delay 5, True '-- Make KH If Document.ComponentSet.ItemByName(BoxDrwg.name & " 2")<> -1 Then ' It does exist Document.ComponentSet.Remove(BoxDrwg.name & " 2") End If Boxdrwg.copy false Delay 2.5, True Document.Paste Set drwg=Document.Componentset(BoxDrwg.name & " 2") drwg.name=BoxDrwg.name & "_KH" Set DrwgTable=Drwg.OwnedTable DrwgTable.name=drwg.name & " Table" ' Color InjStartYear% drwg.Open Set ui = Application.UserInterface ui.Toolbars.Item("Format").ControlSet.Item("EditFormatAreaBackground").PushNamed("Theme") Do ' Nothing Loop Until ui.DisplaysModalDialog Set dlg = ui.ModalDialog With dlg.ControlSet .Item("CheckBoxPreview").Checked = True .Item("ComboBoxColumn").Text = "KH,mdm" .Item("ComboBoxMethod").Text = "Natural Breaks" .Item("ComboBoxPalette").Text = "Temperature" .Item("EditFormatApply").Push '.Item("EditFormatReverse").Push .Item("ButtonOK").Push End With ' Turn on the legend UI.invokeCommand("ViewLegend") set dlg = UI.ModalDialog dlg.ControlSet("CheckBoxShow").Checked = True dlg.accept Drwg.folder=F_Drawings '---- 'Delay 5, True '-- Make K If Document.ComponentSet.ItemByName(BoxDrwg.name & " 2")<> -1 Then ' It does exist Document.ComponentSet.Remove(BoxDrwg.name & " 2") End If Boxdrwg.copy false Delay 2.5, True Document.Paste Set drwg=Document.Componentset(BoxDrwg.name & " 2") drwg.name=BoxDrwg.name & "_K" Set DrwgTable=Drwg.OwnedTable DrwgTable.name=drwg.name & " Table" ' Color drwg.Open Set ui = Application.UserInterface ui.Toolbars.Item("Format").ControlSet.Item("EditFormatAreaBackground").PushNamed("Theme") Do ' Nothing Loop Until ui.DisplaysModalDialog Set dlg = ui.ModalDialog With dlg.ControlSet .Item("CheckBoxPreview").Checked = True .Item("ComboBoxColumn").Text = "K,md" .Item("ComboBoxMethod").Text = "Natural Breaks" .Item("ComboBoxPalette").Text = "Temperature" .Item("EditFormatApply").Push '.Item("EditFormatReverse").Push .Item("ButtonOK").Push End With ' Turn on the legend UI.invokeCommand("ViewLegend") set dlg = UI.ModalDialog dlg.ControlSet("CheckBoxShow").Checked = True dlg.accept Drwg.folder=F_Drawings 'Delay 5, True '-- Make porosity If Document.ComponentSet.ItemByName(BoxDrwg.name & " 2")<> -1 Then ' It does exist Document.ComponentSet.Remove(BoxDrwg.name & " 2") End If Boxdrwg.copy false Delay 2.5, True Document.Paste Set drwg=Document.Componentset(BoxDrwg.name & " 2") drwg.name=BoxDrwg.name & "_Porosity" Set DrwgTable=Drwg.OwnedTable DrwgTable.name=drwg.name & " Table" ' Color drwg.Open Set ui = Application.UserInterface ui.Toolbars.Item("Format").ControlSet.Item("EditFormatAreaBackground").PushNamed("Theme") Do ' Nothing Loop Until ui.DisplaysModalDialog Set dlg = ui.ModalDialog With dlg.ControlSet .Item("CheckBoxPreview").Checked = True .Item("ComboBoxColumn").Text = "Porosity,%" .Item("ComboBoxMethod").Text = "Natural Breaks" .Item("ComboBoxPalette").Text = "Temperature" .Item("EditFormatApply").Push '.Item("EditFormatReverse").Push .Item("ButtonOK").Push End With ' Turn on the legend UI.invokeCommand("ViewLegend") set dlg = UI.ModalDialog dlg.ControlSet("CheckBoxShow").Checked = True dlg.accept Drwg.folder=F_Drawings 'Delay 5, True '-- Make So If Document.ComponentSet.ItemByName(BoxDrwg.name & " 2")<> -1 Then ' It does exist Document.ComponentSet.Remove(BoxDrwg.name & " 2") End If Boxdrwg.copy false Delay 2.5, True Document.Paste Set drwg=Document.Componentset(BoxDrwg.name & " 2") drwg.name=BoxDrwg.name & "_So" Set DrwgTable=Drwg.OwnedTable DrwgTable.name=drwg.name & " Table" ' Color drwg.Open Set ui = Application.UserInterface ui.Toolbars.Item("Format").ControlSet.Item("EditFormatAreaBackground").PushNamed("Theme") Do ' Nothing Loop Until ui.DisplaysModalDialog Set dlg = ui.ModalDialog With dlg.ControlSet .Item("CheckBoxPreview").Checked = True .Item("ComboBoxColumn").Text = "So,%" .Item("ComboBoxMethod").Text = "Natural Breaks" .Item("ComboBoxPalette").Text = "Temperature" .Item("EditFormatApply").Push '.Item("EditFormatReverse").Push .Item("ButtonOK").Push End With ' Turn on the legend UI.invokeCommand("ViewLegend") set dlg = UI.ModalDialog dlg.ControlSet("CheckBoxShow").Checked = True dlg.accept Drwg.folder=F_Drawings 'Delay 5, True '-- Make Thickness If Document.ComponentSet.ItemByName(BoxDrwg.name & " 2")<> -1 Then ' It does exist Document.ComponentSet.Remove(BoxDrwg.name & " 2") End If Boxdrwg.copy false Delay 2.5, True Document.Paste Set drwg=Document.Componentset(BoxDrwg.name & " 2") drwg.name=BoxDrwg.name & "_Thickness" Set DrwgTable=Drwg.OwnedTable DrwgTable.name=drwg.name & " Table" ' Color drwg.Open Set ui = Application.UserInterface ui.Toolbars.Item("Format").ControlSet.Item("EditFormatAreaBackground").PushNamed("Theme") Do ' Nothing Loop Until ui.DisplaysModalDialog Set dlg = ui.ModalDialog With dlg.ControlSet .Item("CheckBoxPreview").Checked = True .Item("ComboBoxColumn").Text = "Thickness,m" .Item("ComboBoxMethod").Text = "Natural Breaks" .Item("ComboBoxPalette").Text = "Temperature" .Item("EditFormatApply").Push '.Item("EditFormatReverse").Push .Item("ButtonOK").Push End With ' Turn on the legend UI.invokeCommand("ViewLegend") set dlg = UI.ModalDialog dlg.ControlSet("CheckBoxShow").Checked = True dlg.accept Drwg.folder=F_Drawings 'Delay 5, True '-- Make WellSpacing,m If Document.ComponentSet.ItemByName(BoxDrwg.name & " 2")<> -1 Then ' It does exist Document.ComponentSet.Remove(BoxDrwg.name & " 2") End If Boxdrwg.copy false Delay 2.5, True Document.Paste Set drwg=Document.Componentset(BoxDrwg.name & " 2") drwg.name=BoxDrwg.name & "_WellSpacing" Set DrwgTable=Drwg.OwnedTable DrwgTable.name=drwg.name & " Table" ' Color drwg.Open Set ui = Application.UserInterface ui.Toolbars.Item("Format").ControlSet.Item("EditFormatAreaBackground").PushNamed("Theme") Do ' Nothing Loop Until ui.DisplaysModalDialog Set dlg = ui.ModalDialog With dlg.ControlSet .Item("CheckBoxPreview").Checked = True .Item("ComboBoxColumn").Text = "WellSpacing,m" .Item("ComboBoxMethod").Text = "Natural Breaks" .Item("ComboBoxPalette").Text = "Temperature" .Item("EditFormatApply").Push '.Item("EditFormatReverse").Push .Item("ButtonOK").Push End With ' Turn on the legend UI.invokeCommand("ViewLegend") set dlg = UI.ModalDialog dlg.ControlSet("CheckBoxShow").Checked = True dlg.accept Drwg.folder=F_Drawings ''''''' Make Wells Drawings If KeepBubbles_Flag=False Then Set Welldrwg=Document.Componentset("WellLocations_Table_Wells") CumBubbles_Flag=false If Application.MessageBoxEx ("Do you want to make Cum Bubbles for wells?", "Making Cum Bubbles takes very long!!" , MessageBoxTypeYesNo) = MessageBoxResultYes Then CumBubbles_Flag=true End If If CumBubbles_Flag Then 'Delay 5, True ' Make Injection Circles If Document.ComponentSet.ItemByName(WellDrwg.name & " 2")<> -1 Then ' It does exist Document.ComponentSet.Remove(WellDrwg.name & " 2") End If Welldrwg.copy false Delay 2.5, True Document.Paste Set drwg=Document.Componentset(WellDrwg.name & " 2") drwg.name=WellDrwg.name & "_WI" Drwg.folder=F_Drawings Set DrwgTable=Drwg.OwnedTable DrwgTable.name=drwg.name & " Table" Drwg.PointForeground.Set(Application.NewColor("white",255,255,255)) Drwg.PointBackground.Set(Application.NewColor("white",255,255,255)) Drwg.PointSize.set(cLng(0)) ' The same can be used for LineSize Drwg.AreaBackground.Set(Application.NewColor("dodgerblue 2",28,134,238)) Drwg.open call DrawCircles(drwg.name,"CumWaterInjection,Radius","0") 'Delay 5, True 'Make Water Production Cirlces If Document.ComponentSet.ItemByName(WellDrwg.name & " 2")<> -1 Then ' It does exist Document.ComponentSet.Remove(WellDrwg.name & " 2") End If Welldrwg.copy false Delay 2.5, True Document.Paste Set drwg=Document.Componentset(WellDrwg.name & " 2") drwg.name=WellDrwg.name & "_WP" Drwg.folder=F_Drawings Set DrwgTable=Drwg.OwnedTable DrwgTable.name=drwg.name & " Table" Drwg.PointForeground.Set(Application.NewColor("white",255,255,255)) Drwg.PointBackground.Set(Application.NewColor("white",255,255,255)) Drwg.PointSize.set(cLng(0)) ' The same can be used for LineSize Drwg.AreaBackground.Set(Application.NewColor("skyblue",135,206,235)) Drwg.open call DrawCircles(drwg.name,"CumLiquidRadius,m","0") 'Delay 5, True 'Make Oil Production Cirlces If Document.ComponentSet.ItemByName(WellDrwg.name & " 2")<> -1 Then ' It does exist Document.ComponentSet.Remove(WellDrwg.name & " 2") End If Welldrwg.copy false Delay 2.5, True Document.Paste Set drwg=Document.Componentset(WellDrwg.name & " 2") drwg.name=WellDrwg.name & "_OP" Drwg.folder=F_Drawings Set DrwgTable=Drwg.OwnedTable DrwgTable.name=drwg.name & " Table" Drwg.PointForeground.Set(Application.NewColor("white",255,255,255)) Drwg.PointBackground.Set(Application.NewColor("white",255,255,255)) Drwg.PointSize.set(cLng(0)) ' The same can be used for LineSize Drwg.AreaBackground.Set(Application.NewColor("green 1 (lime*)",0,255,0)) Drwg.open call DrawCircles(drwg.name,"CumLiquidRadius,m","Oil Fraction, %") End If ' Application.MessageBoxEx End If ' Make Maps 'Delay 5, True 'Template Map Set drwg=Document.ComponentSet("WellLocations_Table_Wells") Set M_Template=Document.NewMap("TempMap",drwg) '--- 'Set drwg=Document.componentSet("WellLocations_Table_Wells_NameLabel") 'Set Layer=Document.NewLayer(drwg) 'M_Template.LayerSet.Add (Layer) 'M_Template.Layerset.Item(0).order = M_Template.Layerset.Count -1 ' Send it to the very first '--- If Document.ComponentSet.ItemByName("Boundary_Table_Polygon")<> -1 Then ' It does exist Set drwg=Document.componentSet("Boundary_Table_Polygon") Set Layer=Document.NewLayer(drwg) M_Template.LayerSet.Add (Layer) M_Template.Layerset.Item(0).order = M_Template.Layerset.Count -1 ' Send it to the very first End If '--- If Document.ComponentSet.ItemByName("WellLocations_Table_Wells_OP")<> -1 Then ' It does exist Set drwg=Document.componentSet("WellLocations_Table_Wells_OP") Set Layer=Document.NewLayer(drwg) M_Template.LayerSet.Add (Layer) M_Template.Layerset.Item(0).order = M_Template.Layerset.Count -1 ' Send it to the very first End If '--- If Document.ComponentSet.ItemByName("WellLocations_Table_Wells_WP")<> -1 Then ' It does exist Set drwg=Document.componentSet("WellLocations_Table_Wells_WP") Set Layer=Document.NewLayer(drwg) M_Template.LayerSet.Add (Layer) M_Template.Layerset.Item(0).order = M_Template.Layerset.Count -1 ' Send it to the very first End If '--- If Document.ComponentSet.ItemByName("WellLocations_Table_Wells_WI")<> -1 Then ' It does exist Set drwg=Document.componentSet("WellLocations_Table_Wells_WI") Set Layer=Document.NewLayer(drwg) M_Template.LayerSet.Add (Layer) M_Template.Layerset.Item(0).order = M_Template.Layerset.Count -1 ' Send it to the very first End If '--- 'Make one Map with all layers included M_Template.Copy false Delay 2.5, True Document.Paste Set NewMap_Master=Document.ComponentSet(M_Template.name & " 2") If Document.ComponentSet.ItemByName("Master" & "_map")<> -1 Then ' It does exist Document.ComponentSet.Remove("Master" & "_map") End If NewMap_Master.name="Master" & "_map" NewMap_Master.Folder=F_Maps Set WorkFold=Document.ComponentSet.Item("Drawings") For each child in WorkFold.children If child.Type = ComponentDrawing and instr(Child.name,"BoxLocations")>0 Then M_Template.Copy false Delay 2.5, True Document.Paste Set NewMap=Document.ComponentSet(M_Template.name & " 2") If Document.ComponentSet.ItemByName(Child.name & "_map")<> -1 Then ' It does exist Document.ComponentSet.Remove(Child.name & "_map") End If NewMap.name=Child.name & "_map" NewMap.Folder=F_Maps ' Add child to master map Set Layer=Document.NewLayer(child) NewMap_Master.LayerSet.Add (Layer) NewMap_Master.Layerset.Item(0).order = NewMap_Master.Layerset.Count -1 ' Send it to the very first 'Add child to individual map Set Layer=Document.NewLayer(child) NewMap.LayerSet.Add (Layer) NewMap.Layerset.Item(0).order = NewMap.Layerset.Count -1 ' Send it to the very first ' Add box for GridAlignment If child.name <> "BoxLocations_Table_Boxes" Then If Document.ComponentSet.ItemByName("WellLocations_Table_Wells_OP")<> -1 Then ' It does exist NewMap.Layerset.Item("WellLocations_Table_Wells_WP").visible=0 NewMap.Layerset.Item("WellLocations_Table_Wells_OP").visible=0 NewMap.Layerset.Item("WellLocations_Table_Wells_WI").visible=0 End If End If If child.name="BoxLocations_Table_Boxes_GridAlign" Then NewMap.Layerset.Item("WellLocations_Table_Wells").visible=0 NewMap.Layerset.Item("Boundary_Table_Polygon").order = NewMap.Layerset.Count -1 Set drwg=Document.componentSet("BoxLocations_Table_Boxes") Set Layer=Document.NewLayer(drwg) NewMap.LayerSet.Add (Layer) NewMap.Layerset.Item(0).order = NewMap.Layerset.Count -1 ' Send it to the very first End If 'Legend NewMap.open UI.invokeCommand("ViewLegend") set dlg = UI.ModalDialog dlg.ControlSet("CheckBoxShow").Checked = True dlg.accept ' Create Layout set Lay=Document.NewLayout(NewMap.Name & "_Layout", NewMap) 'ExportTheMap set UI = Application.userInterface set doc = Application.activeDocument set theWindowSet = Application.windowSet theWindowSet.close() set thelog = Application.History Lay.open() UI.invokecommand "FilePageSetup" set dlg = UI.modaldialog dlg.ControlSet("ComboBox0").Text = Paper If Landscape="True" Then dlg.ControlSet("ButtonLandscape").Checked = True Else dlg.ControlSet("ButtonLandscape").Checked = false End If dlg.accept set oExportPDF = Application.NewExport("PDF") oExportPDF.Compression = False oExportPDF.Resolution = 300 oExportPDF.VectorResolution = 72 oExportPDF.Transparency = True oExportPDF.Export Lay, ExportPath & Mid(NewMap.Name,Instr(NewMap.Name,"Boxes_"),len(NewMap.Name)-Instr(NewMap.Name,"Boxes_")+1) & ".pdf", PromptNone End If Next Document.ComponentSet.Remove(M_Template.name) 'Export Master Map ' Create Layout set Lay=Document.NewLayout(NewMap_Master.Name & "_Layout", NewMap_Master) 'ExportTheMap set UI = Application.userInterface set doc = Application.activeDocument set theWindowSet = Application.windowSet theWindowSet.close() set thelog = Application.History Lay.open() UI.invokecommand "FilePageSetup" set dlg = UI.modaldialog dlg.ControlSet("ComboBox0").Text = Paper If Landscape="True" Then dlg.ControlSet("ButtonLandscape").Checked = True Else dlg.ControlSet("ButtonLandscape").Checked = false End If dlg.accept set oExportPDF = Application.NewExport("PDF") oExportPDF.Compression = False oExportPDF.Resolution = 300 oExportPDF.VectorResolution = 72 oExportPDF.Transparency = True oExportPDF.Export Lay, ExportPath & NewMap_Master.Name & ".pdf", PromptNone 'End If ' GridAlignOnly_Flag=False objExcel.Workbooks.close set objExcel = nothing set workSheets = nothing set sheet = nothing end if End Sub '=================================================================== '=================================================================== function DrawCircles(DrwgName,RadiusColName,FractionColName) Set components = document.ComponentSet ' locate city drawing drawingIndex = components.ItemByName(DrwgName) If drawingIndex < 0 Then MsgBox "No" & DrwgName & " component." Exit function End If Set drawing = components(drawingIndex) ' ensure component type is drawing If drawing.Type <> ComponentDrawing Then MsgBox DrwgName & " is not a drawing." Exit function End If ' obtain set of drawing objects Set objects = drawing.ObjectSet ' ensure drawing is not empty If objects.Count <= 0 Then MsgBox "No objects in " & DrwgName Exit function End If ' obtain owned table and set of table records Set table = drawing.OwnedTable Set records = table.RecordSet ' ensure table contains radius column radiusIndex = table.ColumnSet.ItemByName(RadiusColName) If radiusIndex < 0 Then MsgBox "No " & RadiusColName & " column." Exit function End If Pi = 3.141592653589793 Dim pointIDs ReDim pointIDs(objects.Count-1) pointCount = 0 ' cache IDs of point objects For objectIndex = 0 To objects.Count-1 Set object = objects(objectIndex) If object.Type = ObjectPoint Then pointIDs(pointCount) = object.ID pointCount = pointCount + 1 End If Next If pointCount = 0 Then MsgBox "No points in 'Cum_Prods 2'." Exit function End If ' <<< batch updates here if the number of cities is too large ' create circle for each point object For pointIndex = 0 To pointCount-1 Set object = objects(objects.ItemByID(pointIDs(pointIndex))) Set record = records(records.ItemByID(pointIDs(pointIndex))) ' obtain city location Dim location Set location = object.Geom.Center ' obtain radius of circle from table radius = CDbl(record.Data(RadiusColName)) If len(FractionColName)<2 Then IndexSeparator = 25 Else IndexSeparator = CInt(record.Data(FractionColName)/4) End If If radius>0 and IndexSeparator>0 Then Set pointSet = Application.NewPointSet If len(FractionColName)>2 Then Set point = Application.NewPoint point.X = location.X point.Y = location.Y pointSet.Add(point) End If For i = 0 To IndexSeparator Set point = Application.NewPoint ' calculate angle angle = i*2*Pi/25 ' obtain point of circle point.X = location.X + radius*Cos(angle) point.Y = location.Y + radius*Sin(angle) pointSet.Add(point) Next objects.Add Application.NewGeom(GeomArea, pointSet) End If Next End function '===== Private Sub Delay(s, doLog) ' The Shell.Sleep method is not available within the Manifold context ' so we use an "active" loop instead (occupies a core) Dim i Dim start ' For i = 1 To s start = Now Do ' Nothing Loop Until DateDiff("s", start, Now) >= 1 ' More robust than Timer function ' if operation spans midnight If doLog Then Application.History.Log ".", True Next If doLog Then Application.History.Log vbCrLf, True End Sub