AutoCad - no consigo modificar atributos bloques existentes en dwg

 
Vista:
sin imagen de perfil

no consigo modificar atributos bloques existentes en dwg

Publicado por Enrique Larrosa (1 intervención) el 14/02/2013 14:11:14
Hola a todos

Primero decir que al ser nuevo en el foro, no se si esta forma de proceder es la habitual.
Explicación del problema.
Tengo un plano autocad 2009 con 49 bloques con 8 atributos cada uno. los bloques son el mismo y cuando haces un list puedes ver que cambia el identificador.
donde estoy
1 he creado una macro VBA que se ejecuta desde un icono creado en una barra de herramientas nueva del autocad.
2 la macro abre un fichero excel 2007 de donde deben cogerse los datos.
3 he creado un array donde estan todos los identificadores de los bloques en orden de arriba a abajo.
4 no consigo escojer cada bloque para modificarlo (estoy usando un SelectionSet
5 no consigo modificar los atributos del bloque (estoy usando TagString y un TextString)
6 no consigo que me cree un fichero autocad para cada hoja que posee el fichero excel(solo crea el primero)

¿hay alguna forma de adjuntar los ficheros autocad - excel ?

Adjunto codigo macro VBA.
Agradezco de antemano la colaboración a todos. para poder solucionar el problema porque me urge .
No dudeis em preguntarme cualquier aclaración o duda.
Gracias

'================================
'zona variables
'================================
Public ExcelApp As Excel.Application
Public Wrkbook As Excel.Workbooks
Public Wrksheet As Excel.Worksheet

Dim ss As AutoCAD.AcadSelectionSet

Dim StrNomBlock As String
Dim nomBlockArray() As String
'Dim nomBlock As String

Dim contadorFullesExcel As Variant


'Dim mspace As AcadModelSpace
Dim ssetObj As AcadSelectionSet
Dim acEntidad As Object
'Dim acEntidad As AcadEntity
Dim acadBlkRef As AcadBlockReference
Dim acblock As acadblock
Dim varAttributes As Variant


Dim numDWG As String

Public Sub CreanomBlockArray()

StrNomBlock = "5e4/5da/c57/c61/c6b/c75/c7f/c89/c93/c9d/ca7/cb1/cbb/cc5/ccf/cd9/ce3/ced/cf7/d01/d0b/d15/d1f/d29/d33/"
StrNomBlock = StrNomBlock + "d3d/d47/d51/d5b/d65/d6f/d79/d83/d8d/d97/da1/dab/db5/dbf/dc9/dd3/ddd/de8/df1/dfc/e06/e10/e1a/e23"

'convertimos contenido string a Array siendo el valor de cada posición el que hay entre el separador /
nomBlockArray = Split(StrNomBlock, "/")


End Sub

Function ExcelConnect()
' This function connects excel with autocad

On Error Resume Next

Set ExcelApp = GetObject(, "Excel.Application")
If Err Then
Err.Clear
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Visible = True
If Err Then
MsgBox Err.Description
Exit Function
End If
End If

End Function

Function ExcelClose()
'cerramos fichero Excel
Application.DisplayAlerts = False
Application.Quit

' cierra conexion entre Autocad y excel
Set ExcelApp = Nothing
End Function

Function GetCellValue(row As Integer, column As Integer) As Variant
' This function returns the value of a given cell in excel.
GetCellValue = ExcelApp.ActiveSheet.Cells(row, column).Value
End Function

Public Sub CreaStocklist()
'Set mspace = ThisDrawing.ModelSpace

ExcelConnect
CreanomBlockArray
Workbooks.Open FileName:="C:\dwg\Stocklist_MK135634_MC_L.xlsx"

contadorFullesExcel = ActiveWorkbook.Worksheets.Count
For numFullaExcel = 1 To contadorFullesExcel

Set Wrksheet = Excel.Worksheets("hoja" & CStr(numFullaExcel))
If numFullaExcel = 1 Then
numDWG = "033" 'valor cogido formulario
Else
numDWG = "0" & CStr(Val(numDWG) + 1)
End If

'Set ssetObj = AutoCAD.ActiveDocument.SelectionSets.Add ("SS01")
Set ssetObj = ThisDrawing.SelectionSets.Add("SS01")

For recorrer = LBound(nomBlockArray) To UBound(nomBlockArray)
For Each acEntidad In ssetObj
'If acEntidad.EntityType = acBlockReference And acEntidad.Name = nomBlockArray(recorrer) Then
If acEntidad.Name = nomBlockArray(recorrer) Then
Set acadBlkRef = acEntidad
'como estoy modificando atributos hago una funcion
acadBlkRef = OmplirBlock(acadBlkRef, recorrer)
End If
Next acEntidad

Next recorrer

'vaciamos y borramos el objeto SelectionSet para cada plano Autocad
ssetObj.Clear
ssetObj.Erase



'For Each nomBlock In nomBlockArray
' For row = 1 To 1
' Set block1 = ThisDrawing.Blocks.Item(CStr(nomBlock))
' For column = 1 To 7
' MsgBox Wrksheet.Cells(row, column).Value
'block1(column) = Wrksheet.Cells(row, column)
' Next column
'Next nomBlock
' Next row

ThisDrawing.Regen (acActiveViewport)
AutoCAD.AcadApplication.ZoomExtents

ThisDrawing.SaveAs (numDWG)
AutoCAD.ActiveDocument.Close




Next numFullaExcel

ActiveWindow.Close
Workbooks.Close
ExcelClose
End Sub

Public Function OmplirBlock(ByRef acadBlkRef As AcadBlockReference, ByRef recorrer As Variant) As AcadBlockReference




varAttributes = acadBlkRef.GetAttributes

For i = LBound(varAttributes) To UBound(varAttributes)
If varAttributes(i).TagString = "DETAIL" Then
varAttributes(i).TextString = "1" 'GetCellValue(recorrer,i)
ElseIf varAttributes(i).TagString = "NOUM" Then
varAttributes(i).TextString = "2" 'GetCellValue(recorrer,i)
ElseIf varAttributes(i).TagString = "SHT" Then
varAttributes(i).TextString = "3" 'GetCellValue(recorrer,i)
ElseIf varAttributes(i).TagString = "Q/S" Then
varAttributes(i).TextString = "4" 'GetCellValue(recorrer,i)
ElseIf varAttributes(i).TagString = "MAT" Then
varAttributes(i).TextString = "5" 'GetCellValue(recorrer,i)
ElseIf varAttributes(i).TagString = "MPN" Then
varAttributes(i).TextString = "6" 'GetCellValue(recorrer,i)
ElseIf varAttributes(i).TagString = "DESC/STK" Then
varAttributes(i).TextString = "7" 'GetCellValue(recorrer,i)
ElseIf varAttributes(i).TagString = "PART" Then
varAttributes(i).TextString = "8" 'GetCellValue(recorrer,i)
End If
Next i


End Function
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder