Más difícil todavía

30/01/2007 - 18:01 por Carlos | Informe spam
Hola a todos
Se que esto es muy complicado pero por intentarlo que no sea.
Tengo un listado en una hoja excel de referencias. Esas mismas referencias
las tengo dibujadas en un dibujo de autocad. En el dibujo de autocad cada
referencia está definida como un bloque (con sus propiedades).
Lo que me gustaría es ejecutar una macro que me recorrar la hoja excel y a
cada referencia le cambie el color en el dibujo de autocad en función del
listado que tengo en la hoja excel.
No se si esto es posible

Un saludo

Carlos

Preguntas similare

Leer las respuestas

#6 Carlos
05/02/2007 - 10:33 | Informe spam
Hola Juan
No veo tu direccion por ninguna parte. Si puedes mándame el ejemplo a
(sin el NOSPAN)
Gracias

"Juan M" escribió:

Hola Carlos

Si quieres te puedo pasar el ejemplo completo, solo necesito una direccion
de correo valida, y a ver si en un par de dias te puedo pasar un ejemplo con
los cambios de color.

Mi direccion es la que aparece en los mensajes sin el NOSPAM.

Un saludo
Juan

"Carlos" escribió en el mensaje

> Gracias Juan pero no me funciona. Me da error 429 (El componente Activex
no
> puede crear el objeto)
>
> "Juan M" escribió:
>
> > Hola Carlos
> >
> > Creo que con las versiones LT no es posible emplear vba, ni lisp, ni
arx.
> > Mira las especificaciones en el siguiente enlace
> >
> > http://usa.autodesk.com/adsk/servlet/index?siteID3112&idQ30011
> >
> > Para poder realizar lo que quieres necesitas una version completa (no
LT) de
> > autocad o comprar algun complemento para poder ejecutar rutinas de vba
como
> > la siguiente
> > http://www.cadopolis.com/autocadlt.asp
> > http://www.cadaware.com/
> >
> > Si estoy equivocado y has podido realizar una comentalo y vemos lo que
se
> > puede hacer.
> >
> > Una cosa mas, aunque tengas un listado con los nombres de los bloques,
¿son
> > esos los que guarda autocad, o es el nombre que tu le has dado al
bloque?
> > si son los nombres que da autocad son unicos, si son los que tu has
puesto
> > puede haber mas de uno con ese nombre.
> > Para poder realizar lo que quieres debes recorrer cada entidad y
compararla
> > con con el nombre que tiene, si es alguna de tu lista entonces lo cambia
el
> > color segun el listado. Esto supone que si el dibujo es muy grande, el
> > programa tardara en realizar todos los cambios.
> >
> > Un saludo
> > Juan
> >
> > PD:
> > Si te interesa puedes ver los grupos de noticias de autodesk (en ingles)
> > para la programacion en vba de autocad.
> > Para outlook express:
> > servidor de noticias: discussion.autodesk.com
> > grupo: autodesk.autocad.customization.vba
> >
> > De todas formas me gustaria poder enviarte un ejemplo que tengo con una
hoja
> > de excel para hacer una prueba, te paso todo el codigo:
> >
> > en una hoja de tu libro escribe lo siguiente:
> > [A1]: texto a escribir
> > [B1]: coord X
> > [C1]: coord Y
> > [D1]: coord Z
> > desde [A2:D2] hasta donde quieras los numeros del punto y las
coordenasdas
> > de los mismos.
> >
> > Ahora el codigo:
> >
> > Añade en tu proyecto de vba de excel la referencia a Biblioteca de datos
de
> > autocad y acontinuacion todo el codigo siguiente
> >
> > inicio codigo (en un modulo estandar)
> > Option Explicit
> >
> > Dim WasOpen As Boolean ' To indicate if Acad was already open so You
won't
> > close it in this case
> >
> >
> > Private Function ConnToAcad() As AcadApplication
> >
> > Dim Ac As AcadApplication
> >
> > On Error Resume Next
> > Err.Clear
> > Set Ac = GetObject(, "Autocad.Application") ' the error number I've
got
> > was 429 for no running Acad.
> > '
"Autocad.Application.16" > > > 2005
> > WasOpen = True
> > If Err Then ' Acad wasn't open
> > On Error GoTo ConnToAcadError
> > Set Ac = New AcadApplication
> > WasOpen = False
> > End If
> > On Error GoTo ConnToAcadError
> >
> >
> > Set ConnToAcad = Ac
> >
> > On Error GoTo 0
> > Exit Function
> >
> > ConnToAcadError:
> > MsgBox "Error " & Err.Number & " (" & Err.Description & ") in
procedure
> > OpenExcl of Class Module ExcelHandlerCls"
> > On Error GoTo 0
> > End Function
> >
> >
> > Sub Puntos()
> >
> > Dim Cad As AcadApplication
> > Dim insPoint(0 To 2) As Double 'Declare insertion point
> > Dim finPoint(0 To 2) As Double
> > Dim textHeight As Double 'Declare text height
> > Dim textStr As String 'Declare text string
> > Dim textObj As AcadText 'Declare text object
> > Dim varRet As Variant
> > Dim i As Integer, c As Integer
> > Dim nombre As String, respuesta As String
> > Dim AcadPunto As AcadPoint, AcadLinea As AcadLine
> >
> >
> > Dim CapaLineas As AcadLayer, CapaTexto As AcadLayer
> > Dim CapaPuntos As AcadLayer, CapaPuntos0 As AcadLayer
> >
> > nombre = InputBox("Introduzca el nombre del proyecto", "Proyecto")
> > If nombre = "" Then
> > respuesta = MsgBox("Debe introducir un nombre", vbOKOnly,
> > "Atención")
> > Exit Sub
> > End If
> >
> > Set Cad = ConnToAcad
> > Cad.Visible = True 'to test if it's really there.
> > Set CapaPuntos = Cad.ActiveDocument.Layers.Add("Puntos3D")
> > ' Set CapaLineas = Cad.ActiveDocument.Layers.Add("Lineas")
> > Set CapaTexto = Cad.ActiveDocument.Layers.Add("Texto")
> > Set CapaPuntos0 = Cad.ActiveDocument.Layers.Add("Puntos0")
> >
> > i = 2
> > Do While Cells(i, 2) <> ""
> > insPoint(0) = Cells(i, 2)
> > insPoint(1) = Cells(i, 3)
> > insPoint(2) = Cells(i, 4)
> > textHeight = 1
> > textStr = Cells(i, 1)
> > Set AcadPunto = Cad.ActiveDocument.ModelSpace.AddPoint(insPoint)
> > AcadPunto.Layer = "Puntos3D"
> > Set textObj = Cad.ActiveDocument.ModelSpace.AddText(textStr,
> > insPoint, textHeight)
> > textObj.Layer = "Texto"
> > insPoint(0) = Cells(i, 2)
> > insPoint(1) = Cells(i, 3)
> > insPoint(2) = 0
> > Set AcadPunto = Cad.ActiveDocument.ModelSpace.AddPoint(insPoint)
> > AcadPunto.Layer = "Puntos0"
> > i = i + 1
> > Loop
> > 'Dibuja lineas entre puntos
> > ' For c = 2 To i - 2
> > ' insPoint(0) = Cells(c, 2)
> > ' insPoint(1) = Cells(c, 3)
> > ' insPoint(2) = Cells(c, 4)
> > ' finPoint(0) = Cells(c + 1, 2)
> > ' finPoint(1) = Cells(c + 1, 3)
> > ' finPoint(2) = Cells(c + 1, 4)
> > ' Set AcadLinea = Cad.ActiveDocument.ModelSpace.AddLine(insPoint,
> > finPoint)
> > ' AcadLinea.Layer = "Lineas"
> > ' Next c
> >
> > Cad.ZoomExtents
> > textStr = ThisWorkbook.Path & "\" & nombre & ".dwg"
> > Cad.ActiveDocument.SaveAs textStr
> >
> > End Sub
> >
> > Fin codigo
> >
> >
> > "Carlos" escribió en el mensaje
> > news:
> > > Hola Juan M
> > > Utilizo Autocad LT 2002
> > > En la hoja excel tengo un listado con referencias y datos de cada una,
> > > descripción, peso, medidas, contenedor pero lo que me interesa es el
> > > destino.
> > > En función de un destino u otro quiero dibujar dicha referencia de un
> > > color
> > > concreto. O sea que el listado en excel es como si tuviera únicamente
dos
> > > columnas, una con referencias (que sería el nombre del bloque en
autocad)
> > > y
> > > otra con el color a pintar.
> > >
> > > "Juan M" escribió:
> > >
> > >> Hola Carlos
> > >>
> > >> Me interesa tu problema, pero has dado muy pocos datos. Podrias
indicar
> > >> que
> > >> version de autocad empleas?
> > >> Que valores (referencias) tienes en la hoja de excel y como estan
> > >> distribuidos?
> > >>
> > >> Por lo demas si es posible ya que autocad guarda en su base de datos
como
> > >> se
> > >> llama cada objeto que dibuja y es posible acceder a el y modificar
sus
> > >> propiedades.
> > >>
> > >> Nos comentas los detalles?
> > >>
> > >> Un saludo
> > >> Juan
> > >>
> > >>
> > >> "Carlos" escribió en el mensaje
> > >> > Hola a todos
> > >> > Se que esto es muy complicado pero por intentarlo que no sea.
> > >> > Tengo un listado en una hoja excel de referencias. Esas mismas
> > >> > referencias
> > >> > las tengo dibujadas en un dibujo de autocad. En el dibujo de
autocad
> > >> > cada
> > >> > referencia está definida como un bloque (con sus propiedades).
> > >> > Lo que me gustaría es ejecutar una macro que me recorrar la hoja
excel
> > >> > y a
> > >> > cada referencia le cambie el color en el dibujo de autocad en
función
> > >> > del
> > >> > listado que tengo en la hoja excel.
> > >> > No se si esto es posible
> > >> >
> > >> > Un saludo
> > >> >
> > >> > Carlos
> > >>
> > >>
> > >>
> >
> >
> >



email Siga el debate Respuesta Responder a este mensaje
Ads by Google
Help Hacer una pregunta AnteriorRespuesta Tengo una respuesta
Search Busqueda sugerida