Le portail francophone de la géomatique

Dim pmxdoc As IMxDocument 
Dim pmap As IMap 
Dim ptable As ITable 
Dim pRline As IRubberBand
Dim pLine As IGeometry
Dim pPoints As IPointCollection 
Dim psfilter As ISpatialFilter 
Dim pf_selec As IFeatureSelection 
Dim p_selset As ISelectionSet
Dim pcursor As ICursor 
Dim prow As IRow
Dim msg As String
Dim num_champ As Byte

Private Sub Etude_auto_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)

Set pmxdoc = ThisDocument 
Set pmap = pmxdoc.FocusMap 
Set ptable = pmap.Layer(0) 
Set pRline = New RubberLine 
Set pLine = pRline.TrackNew(pmxdoc.ActiveView.ScreenDisplay, Nothing)
Set pPoints = pLine 
 
Set psfilter = New SpatialFilter 
Set psfilter.Geometry = pPoints 
psfilter.SpatialRel = esriSpatialRelWithin 
Set pf_selec = ptable 
pf_selec.Clear
pf_selec.SelectFeatures psfilter, esriSelectionResultNew, False
 
Dim i As Integer

For i = 1 To pPoints.PointCount
    Set psfilter.Geometry = pPoints.Point(i - 1)
    pf_selec.SelectFeatures psfilter, esriSelectionResultXOR, False
Next i 
 
pmxdoc.ActiveView.Refresh
Set p_selset = pf_selec.SelectionSet
Set pcursor = ptable.Search(psfilter, False) 
pf_selec.SelectionSet.Search Nothing, False, pcursor 

Set prow = pcursor.NextRow
msg = ""
num_champ = ptable.FindField("INSEE")

If prow Is Nothing Then
      msg = "Cliquez sur une commune svp!!"
Else
      Do Until prow Is Nothing
            msg = msg + " 'INSEE' = '" & prow.Value(num_champ) & "' OR "
            Set prow = pcursor.NextRow
      Loop
End If
 
If Len(msg) > 3 Then
msg = Left(msg, Len(msg) - 3)
End If

MsgBox msg
 
Call opengptool

End Sub


 
 
Sub opengptool()
 
Dim puid As New UID
Dim patbext As IArcToolboxExtension
Dim patb As IArcToolbox
Dim ptool As IGPTool
Dim pparams As IArray
Dim pparameter As IGPParameter
Dim pparamedit As IGPParameterEdit
Dim pdatatype As IGPDataType
Dim svalue As String
Dim pcommand As IGPToolCommandHelper

puid = "esrigeoprocessingui.arctoolboxextension"

Set patbext = Application.FindExtensionByCLSID(puid)
Set patb = patbext.ArcToolbox
Set ptool = patb.GetToolbyNameString("test2")
Set pparams = ptool.ParameterInfo

'premier paramètre

Set pparameter = pparams.Element(0)
Set pparamedit = pparameter
Set pdatatype = pparameter.DataType
svalue = " & msg & "
Set pparamedit.Value = pdatatype.CreateValue(svalue)

'second paramètre

Set pparameter = pparams.Element(1)
Set pparamedit = pparameter
Set pdatatype = pparameter.DataType
svalue = "'P:\COUCHES_DONNEES_SIG\CONTOUR ADMINISTRATIF.gdb\CONTOUR_ADMINISTRATIF\COMMUNE"
Set pparamedit.Value = pdatatype.CreateValue(svalue)
 
'troisième paramètre
 
Set pparameter = pparams.Element(2)
Set pparamedit = pparameter
Set pdatatype = pparameter.DataType
svalue = " & msg & "
Set pparamedit.Value = pdatatype.CreateValue(svalue)
 
'quatrième paramètre
 
Set pparameter = pparams.Element(3)
Set pparmedit = pparameter
Set pdatatype = pparameter.DataType
svalue = "P:\COUCHES_DONNEES_SIG\CADASTRE_DPT.gdb\PARCELLAIRE_CHAMPS_COMPLETS
Set pparamedit.Value = pdatatype.CreateValue(svalue)

Set pcommand = New GPToolCommandHelper
pcommand.SetTool ptool
pcommand.Invoke Nothing

 

End Sub