DigiNG edición Scripting

Programación de la orden MARCAR_ATR

Nivel: MEDIO

Vamos a programar una orden denominada MARCAR_ATR muy util para hacer catástros. La orden generará un archivo de errores que posteriormente cargaremos como archivo de referencia con la orden CARGA_F y por cuyos errores iteraremos con las órdenes ERR+ y ERR-, y dichas marcas de error nos indicarán qué entidades lineales tenemos en el archivo sobre el cual se ejecutó la orden con exactamente un determinado número de atributos vinculados con una determinada tabla de la base de datos cargada cuando se ejecutó la orden.

Ej: Si tenemos cargada una base de datos con varias tablas, una de las cuales tiene como nombre TAB, y ejecutamos nuestro script como sigue:

vbscript=marcar_atr.vbs TAB 5 salida.bin

El script generará un archivo denominado err.bin con marcas a todas las entidades lineales con exáctamente 5 atributos enlazados con la tabla TAB de la base de datos activa en el momento de la ejecución del script.

El script admitirá o no parámetros. Si no especificamos parámetros, solicitará mediante cuadros de diálogo los datos necesarios para su ejecución.

El formato de parámetros es el siguiente:

VBSCRIPT=MARCAR_ATR.vbs [tabla] [número de atributos] [archivo a generar]

Y algunos ejemplos de ejecución del script: VBSCRIPT=MARCAR_ATR.vbs

VBSCRIPT=MARCAR_ATR.vbs TAB

VBSCRIPT=MARCAR_ATR.vbs TAB 1

VBSCRIPT=MARCAR_ATR.vbs TAB 1 salida.bin

Comenzamos haciendo un sencillo script que nos muestre un mensaje de error en el caso de que el usuario intente ejecutarlo sin ninguna base de datos cargada:

Option Explicit

If digi.BaseDatos Is Nothing Then

        MsgBox "No hay ninguna base de datos cargada en Digi", vbOkOnly, "Error"

Else

        ' Aquí se encontrará el grueso de nuestro programa

End If

A continuación vamos a introducir la lógica para comprobar los argumentos y solicitar al usuario los parámetros que no se puedan obtener de los argumentos:

Option Explicit

Dim argumentos

Dim rsCATDBS

Dim listaTablas

Dim tabla

Dim numeroAtributos

Dim nombreArchivo

If digi.BaseDatos Is Nothing Then

        MsgBox "No hay ninguna base de datos cargada en Digi", vbOkOnly, "Error"

Else

Set rsCATDBS = CreateObject("ADODB.Recordset")

        rsCATDBS.Open "SELECT NOMBRE FROM CATDBS", digi.BaseDatos

        While NOT rsCATDBS.EOF

            listaTablas = listaTablas + "|"

            listaTablas = listaTablas + rsCATDBS(0)

            rsCATDBS.MoveNext

        Wend

        rsCATDBS.Close       

        Set argumentos = digi.Argumentos

        Select Case argumentos.Count

                Case 0

                tabla = digi.ComboOpciones ("Seleccione tabla", "Seleccione una tabla de entre las mostradas en la siguiente lista", listaTablas)

                numeroAtributos = CInt(InputBox("Introduzca el número de atributos", "Número de atributos"))

                nombreArchivo = digi.DialogoPideArchivo(False)

                Case 1

                tabla = argumentos(0)

                numeroAtributos = CInt(InputBox("Introduzca el número de atributos", "Número de atributos"))

                nombreArchivo = digi.DialogoPideArchivo(False)

                Case 2

                tabla = argumentos(0)

                numeroAtributos = CInt(argumentos(1))

                nombreArchivo = digi.DialogoPideArchivo(False)

                Case 3

                tabla = argumentos(0)

                numeroAtributos = CInt(argumentos(1))

                nombreArchivo = argumentos(2)

        End Select

End If

A continuación vamos a averiguar el valor interno que tiene la tabla seleccionada: Option Explicit

Dim argumentos

Dim rsCATDBS

Dim listaTablas

Dim tabla

Dim numeroAtributos

Dim nombreArchivo

Dim idTAB

If digi.BaseDatos Is Nothing Then

        MsgBox "No hay ninguna base de datos cargada en Digi", vbOkOnly, "Error"

Else

        Set rsCATDBS = CreateObject("ADODB.Recordset")

        rsCATDBS.Open "SELECT NOMBRE FROM CATDBS", digi.BaseDatos

        While NOT rsCATDBS.EOF

            listaTablas = listaTablas + "|"

            listaTablas = listaTablas + rsCATDBS(0)

            rsCATDBS.MoveNext

        Wend

        rsCATDBS.Close       

        Set argumentos = digi.Argumentos

        Select Case argumentos.Count

                Case 0

                tabla = digi.ComboOpciones ("Seleccione tabla", "Seleccione una tabla de entre las mostradas en la siguiente lista", listaTablas)

                numeroAtributos = CInt(InputBox("Introduzca el número de atributos", "Número de atributos"))

                nombreArchivo = digi.DialogoPideArchivo(False)

                Case 1

                tabla = argumentos(0)

                numeroAtributos = CInt(InputBox("Introduzca el número de atributos", "Número de atributos"))

                nombreArchivo = digi.DialogoPideArchivo(False)

                Case 2

                tabla = argumentos(0)

                numeroAtributos = CInt(argumentos(1))

                nombreArchivo = digi.DialogoPideArchivo(False)

                Case 3

                tabla = argumentos(0)

                numeroAtributos = CInt(argumentos(1))

                nombreArchivo = argumentos(2)

        End Select

rsCATDBS.Open "SELECT ID FROM CATDBS WHERE NOMBRE = '" ?        idTAB = rsCATDBS(0)

        rsCATDBS.Close

        Set rsCATDBS = Nothing

End If

Vamos a continuar iterando por todas las entidades del fichero de dibujo y añadiremos las marcas de error para dada línea que cumpla las condiciones siguientes en un array dinámico:

• Condiciones:
• Que no estén borradas
• Que su tipo sea lineal
• Que tengan exáctamente numeroAtributos atributos cuya tabla sea idTAB. Las entidades podrán tener más atributos vinculados con otras tablas, pero con la tablaidTAB tienen que tener exáctamente numeroAtributos atributos.

Option Explicit

Dim argumentos

Dim rsCATDBS

Dim listaTablas

Dim tabla

Dim numeroAtributos

Dim nombreArchivo

Dim idTAB

Dim entidad

Dim coincidentes

Dim ArrayEntidades()

If digi.BaseDatos Is Nothing Then

        MsgBox "No hay ninguna base de datos cargada en Digi", vbOkOnly, "Error"

Else

        Set rsCATDBS = CreateObject("ADODB.Recordset")

        rsCATDBS.Open "SELECT NOMBRE FROM CATDBS", digi.BaseDatos

        While NOT rsCATDBS.EOF

            listaTablas = listaTablas + "|"

            listaTablas = listaTablas + rsCATDBS(0)

            rsCATDBS.MoveNext

        Wend

        rsCATDBS.Close       

        Set argumentos = digi.Argumentos

        Select Case argumentos.Count

                Case 0

                tabla = digi.ComboOpciones ("Seleccione tabla", "Seleccione una tabla de entre las mostradas en la siguiente lista", listaTablas)

                numeroAtributos = CInt(InputBox("Introduzca el número de atributos", "Número de atributos"))

                nombreArchivo = digi.DialogoPideArchivo(False)

                Case 1

                tabla = argumentos(0)

                numeroAtributos = CInt(InputBox("Introduzca el número de atributos", "Número de atributos"))

                nombreArchivo = digi.DialogoPideArchivo(False)

                Case 2

                tabla = argumentos(0)

                numeroAtributos = CInt(argumentos(1))

                nombreArchivo = digi.DialogoPideArchivo(False)

                Case 3

                tabla = argumentos(0)

                numeroAtributos = CInt(argumentos(1))

                nombreArchivo = argumentos(2)

        End Select

        rsCATDBS.Open "SELECT ID FROM CATDBS WHERE NOMBRE = '" ?        idTAB = rsCATDBS(0)

        rsCATDBS.Close

        Set rsCATDBS = Nothing

Set entidad = digi.PrimeraEntidad(True)

        While Not entidad Is Nothing

                If Not (entidad.Borrado) And (entidad.Tipo = vbLinea) And (entidad.Atributos >= numeroAtributos) Then

                        coincidentes = 0

                        For j = 0 To entidad.Atributos - 1

                                If entidad.Atributo(j).Tabla = idTAB Then

                                        coincidentes = coincidentes + 1

                                End If

                        Next

                        If coincidentes=numeroAtributos Then

                                entidades = entidades + 1

                                ReDim Preserve ArrayEntidades( entidades )

                                Set ArrayEntidades(entidades - 1) = AlmacenaError( entidad )

                        End If

                End If

                Set entidad = digi.SiguienteEntidad

        Wend

        For j = 0 To entidades - 1

                Set ArrayEntidades(j) = Nothing

        Next

End If

Function AlmacenaError( entidad )

        Dim x

        Dim y

        Dim linea

        Dim at

        at = digi.AT * digi.Precision

        x = (entidad.Punto(CInt(entidad.Puntos/2)).x + entidad.Punto(CInt(entidad.Puntos/2)-1).x)/2

        y = (entidad.Punto(CInt(entidad.Puntos/2)).y + entidad.Punto(CInt(entidad.Puntos/2)-1).y)/2

        Set linea = CreateObject("Digi3D.Entidad")

        linea.Codigo = digi.Codigo

        linea.AnadePuntoXYZ x, y, 0

        linea.AnadePuntoXYZ x -        at, y + at, 0

        linea.AnadePuntoXYZ x + at, y + at, 0

        linea.AnadePuntoXYZ x + at, y - at, 0

        linea.AnadePuntoXYZ x - at, y - at, 0

        linea.Cerrar

        digi.DibujaEntidad linea

        Set AlmacenaError = linea

End Function

Por último nos queda almacenar el archivo de errores en disco: Option Explicit

Const vbLinea = 1

Dim argumentos

Dim rsCATDBS

Dim listaTablas

Dim tabla

Dim idTAB

Dim numeroAtributos

Dim nombreArchivo

Dim ArrayEntidades()

Dim entidades

Dim coincidentes

Dim j

Dim entidad

If digi.BaseDatos Is Nothing Then

        MsgBox "No hay ninguna base de datos cargada en Digi", vbOkOnly, "Error"

Else

        Set rsCATDBS = CreateObject("ADODB.Recordset")

        rsCATDBS.Open "SELECT NOMBRE FROM CATDBS", digi.BaseDatos

        While NOT rsCATDBS.EOF

            listaTablas = listaTablas + "|"

            listaTablas = listaTablas + rsCATDBS(0)

            rsCATDBS.MoveNext

        Wend

        rsCATDBS.Close       

        Set argumentos = digi.Argumentos

        Select Case argumentos.Count

                Case 0

                tabla = digi.ComboOpciones ("Seleccione tabla", "Seleccione una tabla de entre las mostradas en la siguiente lista", listaTablas)

                numeroAtributos = CInt(InputBox("Introduzca el número de atributos", "Número de atributos"))

                nombreArchivo = digi.DialogoPideArchivo(False)

                Case 1

                tabla = argumentos(0)

                numeroAtributos = CInt(InputBox("Introduzca el número de atributos", "Número de atributos"))

                nombreArchivo = digi.DialogoPideArchivo(False)

                Case 2

                tabla = argumentos(0)

                numeroAtributos = CInt(argumentos(1))

                nombreArchivo = digi.DialogoPideArchivo(False)

                Case 3

                tabla = argumentos(0)

                numeroAtributos = CInt(argumentos(1))

                nombreArchivo = argumentos(2)

        End Select

        rsCATDBS.Open "SELECT ID FROM CATDBS WHERE NOMBRE = '" ?        idTAB = rsCATDBS(0)

        rsCATDBS.Close

        Set rsCATDBS = Nothing

        Set entidad = digi.PrimeraEntidad(True)

        While Not entidad Is Nothing

                If Not (entidad.Borrado) And (entidad.Tipo = vbLinea) And (entidad.Atributos >= numeroAtributos) Then

                        coincidentes = 0

                        For j = 0 To entidad.Atributos - 1

                                If entidad.Atributo(j).Tabla = idTAB Then

                                        coincidentes = coincidentes + 1

                                End If

                        Next

                        If coincidentes=numeroAtributos Then

                                entidades = entidades + 1

                                ReDim Preserve ArrayEntidades( entidades )

                                Set ArrayEntidades(entidades - 1) = AlmacenaError( entidad )

                        End If

                End If

                Set entidad = digi.SiguienteEntidad

        Wend

digi.GuardaArchivo nombreArchivo, ArrayEntidades

        For j = 0 To entidades - 1

                Set ArrayEntidades(j) = Nothing

        Next

End If

Function AlmacenaError( entidad )

        Dim x

        Dim y

        Dim linea

        Dim at

        at = digi.AT * digi.Precision

        x = (entidad.Punto(CInt(entidad.Puntos/2)).x + entidad.Punto(CInt(entidad.Puntos/2)-1).x)/2

        y = (entidad.Punto(CInt(entidad.Puntos/2)).y + entidad.Punto(CInt(entidad.Puntos/2)-1).y)/2

        Set linea = CreateObject("Digi3D.Entidad")

        linea.Codigo = digi.Codigo

        linea.AnadePuntoXYZ x, y, 0

        linea.AnadePuntoXYZ x -        at, y + at, 0

        linea.AnadePuntoXYZ x + at, y + at, 0

        linea.AnadePuntoXYZ x + at, y - at, 0

        linea.AnadePuntoXYZ x - at, y - at, 0

        linea.Cerrar

        digi.DibujaEntidad linea

        Set AlmacenaError = linea

End Function

Fecha de última modificación: jueves, 19 de junio de 2003

© 2001-2003 Dreaming With Objects. Todos los derechos reservados.