Dirección de correo electrónico: ltapiz@clientes.euskaltel.es
Dirección de Web : http://www.euskalnet.net/ltapiz
Teléfono del trabajo : 944204824
Número de fax : 944204268
Teléfono particular : 944755278
Para automatizar estas reseñas he desarrollado un programa informático para Microsoft Word 97 en Visual Basic para aplicaciones que permite incorporar en un documento de word las imágenes (cualquier formato compatible con la inserción de imágenes para Word), las coordenadas U.T.M y geográficas .
Necesidades
Debemos tener en el directorio "C:\Mis documentos" del disco duro del ordenador:
Campo 1-6 nombre de la Estación
Campo 7-8 vacío
Campo 9-18 Coordenada X en formato 123456.789
Campo 19-20 vacío
Campo 21-31 Coordenada Y en formato 1234567.890
Campo 32-33 vacío
Campo 34-41 Coordenada Z en formato 1234.567
Campo 41-final no se tiene en cuenta
FICHERO DE PUNTOS APROXIMADOS ----------------------------- ESTACI X Y Z EMCX. EMCY. EMCZ. ------ ---------- ----------- -------- ----- ----- ----- P1 394142.149 4476123.492 766.893 0.033 0.078 0.103 P2 391651.799 4477414.056 1135.395 0.025 0.061 0.095 P4 393603.628 4478550.603 1261.955 0.023 0.074 0.102 P6 392104.333 4474700.832 1041.336 0.042 0.065 0.103 P3 384534.055 4479182.866 738.748 0.014 0.015 0.052 P5 383468.459 4476602.566 835.891 0.022 0.018 0.068 P12 390826.416 4481082.363 1071.574 0.021 0.057 0.100 |
Con el menú Herramientas=>Plantillas y Complementos=>Agregar incorporamos la plantilla RESEÑA.DOT en la aplicación Microsoft Word .
Con el menú Herramientas=>Macro=>Macros ejecutamos la aplicación reseña y en el Dialogo Abrir Fichero elegimos el camino y fichero que contiene el nombre y coordenadas de las Estaciones y Vértices .
Menú de la utilidad :
Campo con una lista desplegable con todos los Vértices del fichero
elegido anteriormente .
Opción Reseña Horizontal o Vertical .
Comando Página => Inserta una página Horizontal o Vertical
en función de la opción anterior desde el Fichero Horizontal.doc
o Vertical.doc .
Comando Salir => Sale de la aplicación .
| Dim nn$(2000), xx(2000), yy(2000), zz(2000)
'Matriz con nombre y coordenadas X, Y, Z
Public miintervalopagina as Range 'Página en la que estamos situados y que modificamos Private Sub UserForm_Activate()
'Subrutina de principio de la aplicación
Sub substitucion(a$, b$)
'Subrutina para Substituir un texto por otro
Private Sub CommandButton2_Click() 'Comando
para insertar una página Horizontal o Vert.
Private Sub CommandButton3_Click()
'Comando Salir de la aplicación
Private Sub ComboBox1_Change()
'Subrutina cuando cambia el nombre del Vértice
'Subrutina para el Cálculo de las Coordenadas
geográficas y substitución de dichas coordenadas
|
| Este programa pretende simplificar al máximo
todo los Cálculos que un INGENIERO TÉCNICO EN TOPOGRAFÍA
va a necesitar.
* El usuario elige cualquier opción con el ratón. * La entrada de datos es única para todos los cálculos con lo que conseguimos una menor fuente de errores groseros. * Todos los ficheros que se crean automáticamente tienen el mismo nombre que el subdirectorio en el que están y con una extensión que hace referencia al trabajo del cual proviene. * Los datos de campo pueden ser manuales o desde colectores. * Se permite y se recomienda hacer REGLA BESSEL en la lectura de datos puesto que el programa calculara automáticamente las correcciones de colimación y eclímetro. * También podemos hacer varias vueltas de horizonte o estacionarnos varias veces en un mismo estacionamiento. * Utilidades tales como LISTAR, IMPRIMIR. * Cálculos de todo tipo incluyendo MÍNIMOS CUADRADOS. * Creación de nuevos puntos a partir de los calculados. * Aplicaciones tales como SUPERFICIE, REPLANTEOS o HELMERT. * Creación de ficheros. DXF para su posterior plotteo. |
Todos los ficheros están en código ASCII y se pueden listar o editar .Todos los ficheros tienen una cabecera de cuatro lineas que es función del tipo de fichero .
| * .DAT : Fichero
con los datos de campo en el orden siguiente
ESTACI INST. P.VISA PRISM DISTAN. HORIZONT VERTICAL CODIGO ABCDEF 1.345 ABCDEF 1.345 1234.678 123.5678 123.5678 ABCDEF * .PFI : Fichero con los nombres y coordenadas
de los puntos fijos .
* .PAP : Fichero con los nombres y coordenadas
de los puntos aprox. .
* .ANA : Fichero con el resumen
de las observaciones entre Estaciones y Referencias y el calculo de errores
.
* .UNI : Fichero con la reducción
de todas las vueltas de Horizonte poniendo a 0.0000 el ángulo H
al 1º PUNTO VISADO .
*.XYZ : Fichero de calculo de
todos los puntos radiados .
* .Z: Fichero de resultados de los mínimos cuadrados en altimetría * .XY : Fichero de resultados de los mínimos cuadrados en planimetría * .ext : Fichero de resultados de otros cálculos o aplicaciones . La extensión será la que nosotros elijamos . |
| Para cualquier comentario o sugerencia, no dudes en escribirme a mi cuenta de correo electrónica: Correo-e: ltapiz@clientes.euskaltel.es |
Creación de Macros para MicroStation
Muchas de las operaciones que el usuario hace con un programa de dibujo
como MicroStation son repetitivas y para automatizar la seleccion y modificación
de elementos, la elección de controles y ordenes, la manipulación
de dialogos entre usuario y máquina se pueden crear unas macros.
Las macros se escriben en lenguage Visual Basic con unas extensiones
específicas para MicroStation.
El código de las macros se guarda en ficheros de texto, generalmente
con extension ".bas" y su ejecución supone una compilación.
Las macros compiladas se guardan en ficheros binarios con extension ".ba"
y en ellas estan las instrucciones y los dialogos de interface entre usuario
y MicroStation. También es posible crear una página Web HTML
utilizando el menu Utilidades/Autor HTML(SE).
En el directorio de MicroStation\macros existen varias macros ejemplos
para la selección y manipulación de elementos. He desarrollado
varias utilidades en Basic para MicroStation cuyos listados comentados
pienso puedan ser de utilidad para Ingenieros Técnicos en Topografía.
Las últimas versiones de MicroStation incorporan ya unas funciones
que permiten etiquetar coordenadas a puntos ("label point") o vertices
de elementos ya dibujados ("label element") e importar ("import points")
o exportar ("export element") pero por su utilidad didáctica he
decidido escribir las macros nube.bas
, coord.bas
, rellena.bas
y cambiogo.bas
cuyos compilados estan en el fichero macros.exe.
El fichero con las coordenadas X,Y,Z es ASCII y separado con comas
del tipo
A123, 500000.123, 4790123.456, 1234.567
Ir
al principioIr a proyectos
Ir
a anterior
| ' Programa creado por Luis
Miguel TAPIZ
' Nube de puntos desde un fichero ASCII con: ' Nombre o numero , X , Y , Z separados por una coma Sub main
'Variables del menu de dialogo
|
if opcionpunto=1 then 'si
quiero colocar el punto
mbesettings.color=colorpunto'valor de la casilla colorpunto mbesettings.weight=grosorpunto 'casilla grosorpunto mbesettings.level=nivelpunto 'casilla para el nivel punto 'MbeSendCommand envia una orden a MicroStation call MbeSendCommand("PLACE POINT") 'MbeSendDataPoint envia un dato(x,y,z) a la vista 1 call MbeSendDataPoint(punto,1) end if if opcionnumero=1 then 'si quiero colocar el numero mbesettings.color=colornumero mbesettings.weight=grosornumero mbesettings.font=fontnumero 'tipo de letra del numero mbesettings.textheight=val(alturanumero)'altura del nº mbesettings.textwidth=val(anchonumero)'ancho del nº mbesettings.textjustification=MBE_LeftBottom'justificación mbesettings.level=nivelnumero call MbeSendCommand("PLACE TEXT") call MbeSendKeyin(a) call MbeSendDataPoint(punto,1) end if if opcioncota=1 then 'si quiero colocar la cota mbesettings.color=colorcota mbesettings.weight=grosorcota mbesettings.font=fontcota mbesettings.textheight=val(alturacota) mbesettings.textwidth=val(anchocota) mbesettings.textjustification=MBE_RightTop mbesettings.level=nivelcota call MbeSendCommand("PLACE TEXT") call MbeSendKeyin(str$(z)) call MbeSendDataPoint(punto,1) end if wend end if end if 'Antes de salir de la Macro restaura los valores modificados mbesettings.color=salvacolor mbesettings.linestyle=salvaestilos mbesettings.weight=salvagrosor mbesettings.textheight=salvatxhght mbesettings.textwidth=salvatxwdth mbesettings.textjustification=salvajustificacion mbesettings.level=salvanivel 'restablece la configuración 'Envia a MicroStation la orden de seleccion elementos MbeSendCommand("CHOOSE ELEMENT") End Sub 'Fin del programa activando el comando seleccion |
| ' Colocación de Punto,Circulo
y Coordenadas nº X Y
' Luis Miguel TAPIZ EGUILUZ ' Tel=944755278 sub main()
|
'Calcula el punto otro desplazado
el radio en X
otro.x=punto.x + val(radio$):otro.y=punto.y:otro.z=punto.z Call MbeSendDataPoint(otro,vista)'Dato para el radio 'Coloca el numero , la X y la Y Call MbeSendCommand("Place Text") MbeSendKeyin "WT=0" numero=numero + 1 MbeSendKeyin str$(numero) 'Calcula el punto otro desplazado con el angulo de rotación otro.x =punto.x -MbeSettings.TextHeight * sin(angulo!/180*pi) otro.y = punto.y+ MbeSettings.TextHeight * cos(angulo!/180*pi) Call MbeSendDataPoint(otro,vista) texto$=str$(punto.x) 'Alinea los textos "X= e Y=" y pone espacios vacíos if instr(texto$,".")>0 then texto$=space$(9-instr(texto$,".")) &mid$(texto$,1,instr(texto$, ".") +3) else texto$=space$(8-len(texto$)) & texto$ end if MbeSendKeyin " X=" & texto$ otro.x = punto.x:otro.y=punto.y Call MbeSendDataPoint(otro,vista) texto$=str$(punto.y) if instr(texto$,".")>0 then texto$=space$(9-instr(texto$,".")) & mid$(texto$,1,instr(texto$,".")+3) else texto$=space$(8-len(texto$)) & texto$ end if MbeSendKeyin " Y=" & texto$ otro.x = punto.x + MbeSettings.TextHeight * sin(angulo!/180*pi) otro.y=punto.y - MbeSettings.TextHeight * cos(angulo!/180*pi) Call MbeSendDataPoint(otro,vista) MbeSendKeyin " " end if loop end if MbeState.messages = 0 MbeWritePrompt " " MbeWriteCommand " " End sub |
Esta macro no necesita ningun menu de diálogo y sirve para buscar un elemento en un nivel (shape o complex shape en el nivel 3 en este caso) en el fichero de dibujo con el bucle Do While.....Loop y rellenarlo con un color .Esta en el fichero "Rellena.ba" que es a la vez el programa ejecutable .
| ' Relleno de los distintos
elementos de un nivel (3 en este caso)
' y con un color (115 en este caso) ' por Luis Miguel TAPIZ Sub main
' Coloca una marca para el comando UNDO
|
'Envia la orden Cambia relleno
MbeSendCommand "Change Fill" posicionfichero = elemento.FromFile(0) longitudfichero = MbeDgnInfo.EndOfFile 'Desde el principio del fichero hasta el final busca el elemento Do While posicionfichero>=0andposicionfichero< longitudfichero tamaño=elemento.FileSize if elemento.level=3 and (elemento.Type=MBE_Shape or _ elemento.Type=MBE_ComplexShape) then 'Lee las coordenadas origen y final estado = elemento.GetEndPoints(origen,final) '2 datos uno para seleccionar el elemento y otro para confirmar MbeSendDataPoint origen MbeSendDataPoint origen end if 'Se posiciona en el siguiente elemento del fichero Posicionfichero = elemento.FromFile (Posicionfichero + tamaño) Loop End Sub |
Esta Macro permite cambiar el Origen Global a X=2147483.648, Y=-1852516.352, Z=2147483.648 de todos los ficheros incluidos en un directorio de manera que ficheros con mm de unidad de trabajo puedan tener coordenadas U.T.M. con mas de 4000000 en la abscisa Y.
El cambio de Origen Global quedará grabado en el fichero únicamente si salvamos los ajustes con Salvar Ajustes (Save Settings ctrl.F) o poniendo en preferencias Salvar ajustes al Salir del fichero. Esta en el fichero "Cambiogo.ba" que es a la vez el programa ejecutable .
| ' Programa creado por Luis
Miguel TAPIZ.
' Cambia el Global Origin de ' todos los ficheros de un directorio ' del disco duro que elijamos. Sub main fichero$="*.dgn" sugerencia$="*.dgn" 'Para buscar todos los ficheros gráficos filtro$="*.dgn,Fichero Gráfico[*.dgn]" titulo$="Eleccion del disco duro y el directorio" 'Título del menu diálogo directorio$="" accionfichero=MbeFileOpen(fichero$,sugerencia$,filtro$,directorio$,titulo$) if accionfichero=MBE_Success then 'Si no cancelo la acción i=0 while instr(right$(fichero$,i+1),"\") = 0 i=i+1 wend directorio$=mid$(fichero$,1,len(fichero$)-i) 'Esta función devuelve un nombre de fichero del directorio fichero$=dir$(directorio$ & "*.dgn") while fichero<>"" 'Mientras haya ficheros dgn en el directorio MbeSendKeyin("rd=" & directorio$ & fichero$) MbeSendKeyin "GO=-2147483.648,1852516.352,-2147483.648" call MbeSendReset'Para desplazar GO a las Coordenadas MbeSendKeyin "filedesign" 'Para Salvar Ajustes fichero$=dir$ 'Busca otro fichero wend end if End Sub |