Well I revise my post by giving more information for my problem hoping I may get some help please.
I call Procedure 2 from a loop that is within Procedure 1 (see below). The program stacks in the line that creates Thiessen polygons i.e. GP.CreateThiessenPolygons_analysis.... That line is highlighted yellow and arises the message “a run-time error -2147467259 (80004005)”. Below I note Procedures 1 and 2 in VBA. The strange thing is that when I run Procedure 2 isolated by typing the arguments works fine.
I would appreciate it very much helping me because I stacked about a week in just this point and I cannot find out the problem. Thanks Demetris
'PROCEDURE 1
Public Sub CreateNewGeneration(BlockID As String)
CreateMatingTable
Dim NumLayers As Integer
Dim index As Integer
NumLayers = CountLayersMP(BlockID)
Dim i As Integer
Dim j As Integer
j = NumLayers
Dim Mp1 As Integer
Dim MP2 As Integer
Dim Sol1 As Integer
Dim Sol2 As Integer
Mp1 = 0
MP2 = 0
Sol1 = 0
Sol2 = 0
Dim UpperBound As Integer
Dim LowerBound As Integer
UpperBound = NumLayers
LowerBound = 1
'Select randomly two numbers from 1 to NumLayers
Dim check2 As Boolean
check2 = False
For i = 1 To j
ReRandom:
Mp1 = Int((UpperBound - LowerBound + 1) * Rnd + LowerBound)
MP2 = Int((UpperBound - LowerBound + 1) * Rnd + LowerBound)
If Mp1 = MP2 Then
GoTo ReRandom
End If
Sol1 = GetSol(Mp1)
Sol2 = GetSol(MP2)
If Sol1 = Sol2 Then
GoTo ReRandom
End If
Dim strSol1 As String
Dim strSol2 As String
Dim strMP1 As String
Dim strMP2 As String
Dim stri As String
strSol1 = CStr(Sol1)
strSol2 = CStr(Sol2)
strMP1 = CStr(Mp1)
strMP2 = CStr(MP2)
If i = 1 Then
Call MoveCentroidsonAverage(BlockID, strSol1, strSol2, strMP1, strMP2)
Call CreateCrossOverSolution(BlockID, strSol1, strSol2, strMP1, strMP2, i)
Call UpdateMatingTable(Mp1, MP2, Sol1, Sol2)
End If
If i > 1 Then
check2 = CheckMatingTable(Mp1, MP2, Sol1, Sol2)
If check2 = True Then
GoTo ReRandom
Else
Call MoveCentroidsonAverage(BlockID, strSol1, strSol2, strMP1, strMP2)
'CALL PROCEDURE 2 (CreateCrossOverSolution) which is shown after the End Sub
Call CreateCrossOverSolution(BlockID, strSol1, strSol2, strMP1, strMP2, i)
Call UpdateMatingTable(Mp1, MP2, Sol1, Sol2)
End If
End If
'
Sol1 = 0
Sol2 = 0
Next i
Call DeleteMPtables("1")
Call DeleteMPtables("2")
Call DeleteLayersMP("VectorB", BlockID)
Call DeleteMatingTable
End Sub
'PROCEDURE 2
Public Sub CreateCrossOverSolution(BlockID As String, Solindex1 As String, Solindex2 As String, _
MPindex1 As String, MPindex2 As String, popNo As Integer)
Dim GP As Object
Set GP = CreateObject("esriGeoprocessing.GpDispatch.1")
'''''' Set the necessary product code
GP.SetProduct "ArcInfo"
'Set the toolbox
GP.AddToolbox "C:/Program Files/ArcGIS/ArcToolbox/Toolboxes/Conversion Tools.tbx"
GP.AddToolbox "C:/Program Files/ArcGIS/ArcToolbox/Toolboxes/Analysis Tools.tbx"
GP.AddToolbox "C:/Program Files/ArcGIS/ArcToolbox/Toolboxes/Data Management Tools.tbx"
GP.Extent = "144566.589424817 351191.130242809 145772.160174817 353810.742942809"
Dim Output_Feature_Class As String
Dim Thiessens As String
Dim LandBlock As String
Dim strPopNo As String
strPopNo = CStr(popNo)
'**************The line that causes the run-time error
GP.CreateThiessenPolygons_analysis "C:\LACONISS\LandSpaCES\CentroidsB" & BlockID & ".shp", _
"C:\LACONISS\LandSpaCES\ThiessenNew" & BlockID & "_" & popNo & ".shp", "ONLY_FID"
UpdateCentroidsB (BlockID)
'''' 'Select block
GP.Select_analysis "C:\LACONISS\LandSpaCES\LandBlocks.shp", _
"C:\LACONISS\LandSpaCES\LandBlock" & BlockID & ".shp", "Block_ID =" & BlockID
Output_Feature_Class = "C:\LACONISS\LandSpaCES\VectorB" & BlockID & "_" & popNo & ".shp"
Thiessens = "ThiessenNew" & BlockID & "_" & popNo
LandBlock = "LandBlock" & BlockID
' Process: Clip...
GP.Clip_analysis Thiessens, LandBlock, Output_Feature_Class, ""
Call UpDateVector3BG(BlockID, strPopNo)
Call UpdateVector3BValue(BlockID, strPopNo)
Call DeleteFCclass2("ThiessenNew", BlockID, strPopNo)
Call DeleteFCclass("LandBlock", BlockID)
End Sub
