Como dibujar desde access en autocad
Estoy haciendo una pequeña base de datos para calcular presupuestos.
La base de datos es sobre ventanas
La idea es que al poner las medidas de una ventana, y alguna otra característica que seguro que ya sabes tu, por medio de alguna macro o algo (estoy un poco perdido en como empezar) me la dibuje en autocad y me la guarde en un archivo.
De momento, lo que hago es un objeto Ole, que habré autocad, dibujo la ventana, y al cerrar autocad ya me queda. Pero querría optimizarla, de manera que ya la dibuje, toda o casi toda tan pronto como entre en autocad.
Te agradecería toda la ayuda posible. Un ejemplo sencillo o manual sobre este tema para poder arrancar.
La base de datos es sobre ventanas
La idea es que al poner las medidas de una ventana, y alguna otra característica que seguro que ya sabes tu, por medio de alguna macro o algo (estoy un poco perdido en como empezar) me la dibuje en autocad y me la guarde en un archivo.
De momento, lo que hago es un objeto Ole, que habré autocad, dibujo la ventana, y al cerrar autocad ya me queda. Pero querría optimizarla, de manera que ya la dibuje, toda o casi toda tan pronto como entre en autocad.
Te agradecería toda la ayuda posible. Un ejemplo sencillo o manual sobre este tema para poder arrancar.
2 respuestas
Respuesta de lesoleil
1
Lo que pides no es nada fácil, y en lo que he investigado respecto a la relación de AutoCAD y Access, me atrevería a decir que imposible... a sí a simple planteamiento. Y me explico: que sepa, para conseguir eso, necesitas programar una serie de rutinas y lisp personalizadas que lo puedan hacer.
Ya te digo, es posible, pero es demasiado lo que le pides... Digamos que no viene de fábrica.
El AutoCAD y el Access, que yo sepa, sólo son capaces de "mostrar" informaciones. Es decir: que desde el gráfico CAD se abra al tabla con los datos del obejo y que, desde el Formulario, se muestre el gráfico CAD.
En fin, siento no darte buenas noticias, pero la misma decepción me llevé yo, porque también me habían "vendido" esa posibilidad. Algún día con tiempo me meteré a programar, pero, de momento, he aprovechado DesignCenter y Paletas de Herramientas para cubrir esa necesidad.
Gracias de antemano por cerrar la preguntiña, salvo que quieras algo más, que aquí estamos para responder. Un saudiño...
Ya te digo, es posible, pero es demasiado lo que le pides... Digamos que no viene de fábrica.
El AutoCAD y el Access, que yo sepa, sólo son capaces de "mostrar" informaciones. Es decir: que desde el gráfico CAD se abra al tabla con los datos del obejo y que, desde el Formulario, se muestre el gráfico CAD.
En fin, siento no darte buenas noticias, pero la misma decepción me llevé yo, porque también me habían "vendido" esa posibilidad. Algún día con tiempo me meteré a programar, pero, de momento, he aprovechado DesignCenter y Paletas de Herramientas para cubrir esa necesidad.
Gracias de antemano por cerrar la preguntiña, salvo que quieras algo más, que aquí estamos para responder. Un saudiño...
Admiro tu paciencia. Así como lo cuentas... de verdad que la admiro... Lo que he visto del tema es como para tenerla... y muy grande!
Estás metido donde tenía que haberme metido yo hace ya algún tiempo y preferí esperar... En fin, si puedes/quieres enviármelo, casi que te lo agradezco. Incluso es posible que pueda ayudar a desarrollar el asunto... Desde el punto de vista profesional, solucionamos el tema con software GIS de Geomedia que está "pensado para eso" [evidentemente, nos dedicamos a temas urbanísticos y obra civil...], pero personalmente sí que quiero estudiar hasta donde podríamos llegar...
En fin, ¿cómo hacemos? ¿Me dejas tu email o Messenger y hablamos? Por mi parte, si algo puedo aportar...
Un saudiño...
Estás metido donde tenía que haberme metido yo hace ya algún tiempo y preferí esperar... En fin, si puedes/quieres enviármelo, casi que te lo agradezco. Incluso es posible que pueda ayudar a desarrollar el asunto... Desde el punto de vista profesional, solucionamos el tema con software GIS de Geomedia que está "pensado para eso" [evidentemente, nos dedicamos a temas urbanísticos y obra civil...], pero personalmente sí que quiero estudiar hasta donde podríamos llegar...
En fin, ¿cómo hacemos? ¿Me dejas tu email o Messenger y hablamos? Por mi parte, si algo puedo aportar...
Un saudiño...
Respuesta de Raul Hernandez
1
Acabo de responder una pregunta parecida pero con excel, en el ejemplo que envíe se abre excel desde autocad y se dibuja con la información que esta en excel.
Aquí te rennvio tal cual como hace 5 min espero te sirva
-------------------------------------
Aquí te muestro una manera muy sencilla de realizar lo que pides, asumí que el archivo de excel esta configurado de la siguiente forma:
X Y Texto
X Y
X Y Texto
POR Y
Crea un proyecto de Visual Basic en Autocad, inserta un modulo y copia las lineas de abajo.
Espero esto te sirva, pero de todos modos ponte en contacto conmigo si necesitas más ayuda.
Te recuerdo que esta es la forma más sencilla de hacerlo ya que es muy básica, si necesitas otras cosas contáctame.
Saludos
Sub graficar()
Dim PtoIn(0 To 2) As Double
Dim PtoFin(0 To 2) As Double
Dim Texto As String
Dim PtoIns(0 To 2) As Double
'Conecta con excel
Set App = CreateObject("Excel.Application")
'Abre el archivo - solo cambia por la ruta y nombre de tu archivo -
App.Workbooks.Open FileName:="C:\Book1.xls"
'Visualiza Excel -Si no necesitas Excel visible omite esta linea -
App.Visible = True
'Estoy asumiendo que el archivo esta estructurado de la siguiente manera
'Columna A - coordenada X, Columna B - Coordenada Y, Columna C - Texto
App.Range("A1").Select
PtoIn(0) = App.ActiveCell.Value
'Aqui estoy en B1
App.ActiveCell.Offset(0, 1).Select
PtoIn(1) = App.ActiveCell.Value
'Aqui estoy en C1
App.ActiveCell.Offset(0, 1).Select
Texto = App.ActiveCell.Value
'Aqui estoy en A2
App.ActiveCell.Offset(1, -2).Select
PtoFin(0) = App.ActiveCell.Value
'Aqui estoy en B2
App.ActiveCell.Offset(0, 1).Select
PtoFin(1) = App.ActiveCell.Value
'Aqui se Cierra Excel
App.Quit
'Esto hace un llamado a la rutina NewLine para que dibuje la linea
Call NewLine(PtoIn, PtoFin, "0")
'Ahora calculamos el centro de la linea para insertar el texto
PtoIns(0) = (PtoIn(0) + PtoFin(0)) / 2
PtoIns(1) = (PtoIn(1) + PtoFin(1)) / 2
'Esto hace un llamado a la rutina NewText para que dibuje la texto
Call NewText(Texto, PtoIns, 2, 0, 0, 0, "0")
End Sub
'Esta rutina dibuja lineas y las coloca en un layer creado previamente
'los parametros son los siguientes: AUX1 es el punto inicial
'AUX2 es el punto final, Layer es el nombre del layer donde deseas colocar la linea
Sub NewLine(AUX1() As Double, AUX2() As Double, Layer As String)
Dim ACADDOC As Object
Dim ACADDOCMS As Object
Set ACADDOC = GetObject(, "Autocad.Application").ActiveDocument
Set ACADDOCMS = ACADDOC.ModelSpace
Set ObjLine = ACADDOCMS.AddLine(AUX1, AUX2)
ObjLine.Layer = Layer
ObjLine.Update
End Sub
'Esta rutina inserta textos, los coloca en un layer creado previamente
'los parametros son los siguientes: Text contiene el texto a insertar, AUX es el punto de insercion
'Height contiene la altura que va a tener el texto, THA y THV estas variables controlan la justificacion
'horizontal y vertiucal del texto sus valores son: 0-derecha,arriba; 1-centro,centro; 2-izquierda,abajo
'respectivamente para THA y THV, TR esta variable controla la rotacion del texto, sus valores son 0 y 1
'para 0 y 90 grados respectivamente y Layer ya fue descrito.
Sub NewText(Text As String, AUX() As Double, Height As Double, THA As Integer, TVA As Integer, TR As Integer, Layer As String)
Const Pi As Double = 3.14159265359
Dim ACADDOC As Object
Dim ACADDOCMS As Object
Dim AcadUtil As Object
Dim Pto(0 To 2) As Double
Pto(0) = 0: Pto(1) = 0
Set ACADDOC = GetObject(, "Autocad.Application").ActiveDocument
Set ACADDOCMS = ACADDOC.ModelSpace
Set TextObj = ACADDOCMS.AddText(Text, AUX, Height)
If THA = 0 Then
TextObj.HorizontalAlignment = acHorizontalAlignmentRight
ElseIf THA = 1 Then
TextObj.HorizontalAlignment = acHorizontalAlignmentCenter
ElseIf THA = 2 Then
TextObj.HorizontalAlignment = acHorizontalAlignmentLeft
End If
If TVA = 0 Then
TextObj.VerticalAlignment = acVerticalAlignmentTop
ElseIf TVA = 1 Then
TextObj.VerticalAlignment = acVerticalAlignmentMiddle
ElseIf TVA = 2 Then
TextObj.VerticalAlignment = acVerticalAlignmentBotom
End If
If TR = 1 Then
TextObj.Rotation = Pi / 2
End If
TextObj.Layer = Layer
Call TextObj.Move(Pto, AUX)
End Sub
Aquí te rennvio tal cual como hace 5 min espero te sirva
-------------------------------------
Aquí te muestro una manera muy sencilla de realizar lo que pides, asumí que el archivo de excel esta configurado de la siguiente forma:
X Y Texto
X Y
X Y Texto
POR Y
Crea un proyecto de Visual Basic en Autocad, inserta un modulo y copia las lineas de abajo.
Espero esto te sirva, pero de todos modos ponte en contacto conmigo si necesitas más ayuda.
Te recuerdo que esta es la forma más sencilla de hacerlo ya que es muy básica, si necesitas otras cosas contáctame.
Saludos
Sub graficar()
Dim PtoIn(0 To 2) As Double
Dim PtoFin(0 To 2) As Double
Dim Texto As String
Dim PtoIns(0 To 2) As Double
'Conecta con excel
Set App = CreateObject("Excel.Application")
'Abre el archivo - solo cambia por la ruta y nombre de tu archivo -
App.Workbooks.Open FileName:="C:\Book1.xls"
'Visualiza Excel -Si no necesitas Excel visible omite esta linea -
App.Visible = True
'Estoy asumiendo que el archivo esta estructurado de la siguiente manera
'Columna A - coordenada X, Columna B - Coordenada Y, Columna C - Texto
App.Range("A1").Select
PtoIn(0) = App.ActiveCell.Value
'Aqui estoy en B1
App.ActiveCell.Offset(0, 1).Select
PtoIn(1) = App.ActiveCell.Value
'Aqui estoy en C1
App.ActiveCell.Offset(0, 1).Select
Texto = App.ActiveCell.Value
'Aqui estoy en A2
App.ActiveCell.Offset(1, -2).Select
PtoFin(0) = App.ActiveCell.Value
'Aqui estoy en B2
App.ActiveCell.Offset(0, 1).Select
PtoFin(1) = App.ActiveCell.Value
'Aqui se Cierra Excel
App.Quit
'Esto hace un llamado a la rutina NewLine para que dibuje la linea
Call NewLine(PtoIn, PtoFin, "0")
'Ahora calculamos el centro de la linea para insertar el texto
PtoIns(0) = (PtoIn(0) + PtoFin(0)) / 2
PtoIns(1) = (PtoIn(1) + PtoFin(1)) / 2
'Esto hace un llamado a la rutina NewText para que dibuje la texto
Call NewText(Texto, PtoIns, 2, 0, 0, 0, "0")
End Sub
'Esta rutina dibuja lineas y las coloca en un layer creado previamente
'los parametros son los siguientes: AUX1 es el punto inicial
'AUX2 es el punto final, Layer es el nombre del layer donde deseas colocar la linea
Sub NewLine(AUX1() As Double, AUX2() As Double, Layer As String)
Dim ACADDOC As Object
Dim ACADDOCMS As Object
Set ACADDOC = GetObject(, "Autocad.Application").ActiveDocument
Set ACADDOCMS = ACADDOC.ModelSpace
Set ObjLine = ACADDOCMS.AddLine(AUX1, AUX2)
ObjLine.Layer = Layer
ObjLine.Update
End Sub
'Esta rutina inserta textos, los coloca en un layer creado previamente
'los parametros son los siguientes: Text contiene el texto a insertar, AUX es el punto de insercion
'Height contiene la altura que va a tener el texto, THA y THV estas variables controlan la justificacion
'horizontal y vertiucal del texto sus valores son: 0-derecha,arriba; 1-centro,centro; 2-izquierda,abajo
'respectivamente para THA y THV, TR esta variable controla la rotacion del texto, sus valores son 0 y 1
'para 0 y 90 grados respectivamente y Layer ya fue descrito.
Sub NewText(Text As String, AUX() As Double, Height As Double, THA As Integer, TVA As Integer, TR As Integer, Layer As String)
Const Pi As Double = 3.14159265359
Dim ACADDOC As Object
Dim ACADDOCMS As Object
Dim AcadUtil As Object
Dim Pto(0 To 2) As Double
Pto(0) = 0: Pto(1) = 0
Set ACADDOC = GetObject(, "Autocad.Application").ActiveDocument
Set ACADDOCMS = ACADDOC.ModelSpace
Set TextObj = ACADDOCMS.AddText(Text, AUX, Height)
If THA = 0 Then
TextObj.HorizontalAlignment = acHorizontalAlignmentRight
ElseIf THA = 1 Then
TextObj.HorizontalAlignment = acHorizontalAlignmentCenter
ElseIf THA = 2 Then
TextObj.HorizontalAlignment = acHorizontalAlignmentLeft
End If
If TVA = 0 Then
TextObj.VerticalAlignment = acVerticalAlignmentTop
ElseIf TVA = 1 Then
TextObj.VerticalAlignment = acVerticalAlignmentMiddle
ElseIf TVA = 2 Then
TextObj.VerticalAlignment = acVerticalAlignmentBotom
End If
If TR = 1 Then
TextObj.Rotation = Pi / 2
End If
TextObj.Layer = Layer
Call TextObj.Move(Pto, AUX)
End Sub