Hola soy ingeniero civil y necesito realizar un plano en autocad, ya esta el levantamiento topográfico de la zona y quiero saber si tienes la rutina para dibujar desde la base de datos de Excel gracias por tu ayuda que tengas un feliz día.
Hace un poco tiempo respondí algunas preguntas parecidas a esta. La respuesta esta realizada para insertar lineas, textos. Ahora si lo que necesitas es insertar información topográfica cruda, es decir, angulo horizontal, distancia y angulo vertical, te recomiendo que uses Autodesk Land Development para que realices estas tareas. De todas maneras espero que la rutina que te envío te sirva de algo y si por el contrario necesitas información acerca del Land para insertar la información, contáctame de nuevo por aquí o por mi MSN que esta en mi página. Saludos 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