hi could help me with this problem I have
I'm trying to make a visual basic code in selection of shp (line, point) once the take by selecting table data to a document (text, excel) to join the two into a single table ... I need your help
the code:
Dim pRuta As String ' .mxd
Dim pValor_1 As String
Dim pValor_2 As String
Dim pValor_3 As String
Dim pValor_4 As String
Dim pValor_5 As String
Sub RutaMXD()
Dim pMxdoc As MxDocument
Set pMxdoc = ThisDocument
Dim pProject As VBProject
Set pProject = pMxdoc.VBProject
pRuta = ParsePath(pProject.FileName, "PATH_ONLY")
End Sub
Function ParsePath(strPath As String, lngPart As String) As String
' Este procedimiento obtiene la ruta del archivo dependiendo de la constante empleada
Dim lngPos As Long
Dim strPart As String
Dim blnIncludesFile As Boolean
lngPos = InStrRev(strPath, "\")
blnIncludesFile = InStrRev(strPath, ".") > lngPos
Select Case lngPart
' Retorna la ruta completa.
Case "FULL_ONLY"
If blnIncludesFile Then
strPart = Left$(strPath, lngPos) & Right$(strPath, Len(strPath) - lngPos)
Else
strPart = strPath
End If
' Retorna el nombre del archivo.
Case "FILE_ONLY"
If blnIncludesFile Then
strPart = Right$(strPath, Len(strPath) - lngPos)
Else
strPart = ""
End If
' Retorna la ruta.
Case "PATH_ONLY"
If blnIncludesFile Then
strPart = Left$(strPath, lngPos)
Else
strPart = strPath
End If
' Retorna el drive.
Case "DRIVE_ONLY"
strPart = Left$(strPath, 3)
' Retorna la extensión del archivo.
Case "FILEEXT_ONLY"
If blnIncludesFile Then
strPart = Mid(strPath, InStrRev(strPath, ".") + 1, 3)
Else
strPart = ""
End If
Case Else
strPart = ""
End Select
ParsePath = strPart
ParsePath_End:
Exit Function
End Function
Sub ObtenerValores()
Dim pDoc As IMxDocument
Dim pMap As IMap
Dim pLayer As IFeatureLayer
Dim pFSel As IFeatureSelection
Dim pFeat As IFeature
Dim pSelSet As ISelectionSet
Dim pCur As IFeatureCursor
Set pDoc = ThisDocument
Set pMap = pDoc.FocusMap
'Define el layer seleccionado en la TOC como el layer de trabajo
Set pLayer = pDoc.SelectedLayer
'Obtener los elementos seleccionados del layer
Set pFSel = pLayer
Set pSelSet = pFSel.SelectionSet
'Asegurar que exista un elemento seleccionado
If pFSel.SelectionSet.Count < 1 Then
MsgBox "NO features selected in layer " & pLayer.Name
Exit Sub
End If
pSelSet.Search Nothing, False, pCur
Set pFeat = pCur.NextFeature
Do Until pFeat Is Nothing
'Modificar el nombre de los campos de acuerdo a tu necesidad
pValor_1 = pFeat.Value(pFeat.Fields.FindField("FID")) 'Identificador del polígono
pValor_2 = pFeat.Value(pFeat.Fields.FindField("CODIGO_DIS"))
pValor_3 = pFeat.Value(pFeat.Fields.FindField("CODIGO_DEP"))
pValor_4 = pFeat.Value(pFeat.Fields.FindField("CODIGO_PRO"))
pValor_5 = pFeat.Value(pFeat.Fields.FindField("DISTRITO"))
Set pFeat = pCur.NextFeature
Loop
End Sub
Sub GenerarArchivoTexto()
' Generar el archivo txt
Open pRuta & pValor_1 & ".txt" For Output As #1
' Escriba los valores en el archivo txt
Print #1, "FID " & "CODIGO_DIS " & "CODIGO_DEP " & "CODIGO_PRO " & "DISTRITO"
Print #1, pValor_1 & " " & pValor_2 & " " & pValor_3 & " " & pValor_4 & " " & pValor_5
' Cerrar el archivo txt
Close #1
End Sub
