Hola amigos de Autodesk, deseria poder leer los atributos de los bloques y tambien modificarlos
con visual basic 6, tengo varias archivos ,dwg y hay muchos bloques con sus respectivos atributos
los cuales quiero modfiicar manualmente, tengo el Autocad 2012 en español espero me puesan ayudar!!!
Luis Tomasto
I'm not sure if this works in A2012
You may want to try it:
'--------------Code start--------------------
Option Explicit
' ! request references:
' 1. - Microsoft Shell Controls And Automation
' 2. - Windows Script Host Object Model
' 3. - Microsoft Scripting RunTime
' 4. - AutoCAD/ObjectDBX Common XX.X Library !
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'-------------------------------------------------------------
Function GetFolder(Optional ByVal Name As String = _
"Select a folder.") As String
'-------------------------------------------------------------
Dim bInfo As BROWSEINFO
Dim path As String
Dim oDialog As Long
bInfo.pidlRoot = 0& 'Root folder = Desktop
bInfo.lpszTitle = Name
bInfo.ulFlags = &H1 'Type of directory to Return
oDialog = SHBrowseForFolder(bInfo) 'display the dialog
'Parse the result
path = Space$(512)
GetFolder = ""
If SHGetPathFromIDList(ByVal oDialog, ByVal path) Then
GetFolder = Left(path, InStr(path, Chr$(0)) - 1) & "\"
End If
End Function
Private Function getFiles(ByVal RootFolder As String, ByRef FileColl As Collection)
Dim fs, f, item, mystring As String
Dim File As Variant, folder As Variant
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(RootFolder)
For Each File In f.files
If UCase(Right(File.Name, 4)) = UCase(".dwg") Then
FileColl.Add File.path
End If
Next
For Each folder In f.SubFolders
Call getFiles(folder, FileColl)
Next
End Function
Private Sub ChangeBlocksDBX(dwgFiles As Collection, blkname As String, atag As String, aValue As String)
Dim oEnt As AcadEntity
Dim oBlkRef As AcadBlockReference
Dim oAtt As AcadAttributeReference
Dim oBlock As AcadBlock
Dim oLayout As AcadLayout
Dim vers As Double
vers = Val(Application.ActiveDocument.GetVariable("acadver"))
Dim dbxvers As String
dbxvers = "ObjectDBX.AxDbDocument." & Left(Application.ActiveDocument.GetVariable("acadver"), 2)
Dim dbxDoc As New AxDbDocument
Set dbxDoc = ThisDrawing.Application.GetInterfaceObject(dbxvers)
Dim dwgVar As Variant
On Error Resume Next
For Each dwgVar In dwgFiles
Dim dwgName As String
dwgName = CStr(dwgVar)
dbxDoc.Open dwgName
For Each oLayout In dbxDoc.Layouts
For Each oEnt In oLayout.Block
If TypeOf oEnt Is AcadBlockReference Then
Set oBlkRef = oEnt
If oBlkRef.EffectiveName = blkname Then
Dim attVar As Variant
attVar = oBlkRef.GetAttributes
Dim i
For i = 0 To UBound(attVar)
Set oAtt = attVar(i)
If oAtt.TagString = atag Then
oAtt.TextString = aValue
Exit For
End If
Next i
End If
End If
Next
Next
dbxDoc.SaveAs dwgName
Next
On Error Resume Next
Set dbxDoc = Nothing
End Sub
Public Sub Hola()
Dim blkname As String
Dim atag As String
Dim attvalue As String
blkname = InputBox("Enter a block name:", "Batch attribute change")
atag = UCase(InputBox("Enter an attribute tag:", "Batch attribute change"))
attvalue = InputBox("Enter a new attribute value:", "Batch attribute change")
Dim strFolder As String
Dim item As Variant
Dim FileColl As Collection
Set FileColl = New Collection
strFolder = GetFolder("Select directory to change attribute") ', ThisDrawing.GetVariable("dwgprefix"))
If strFolder = "" Then Exit Sub
If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"
Call getFiles(strFolder, FileColl)
Call ChangeBlocksDBX(FileColl, blkname, atag, attvalue)
MsgBox "done"
End Sub
'-------------------code end ------------------------------
~'J'~
Man,
This code on pure VBA, I just show you the way
You can to convert it on vb.net by yourself
Take a look at this link it may helps:
http://forums.autodesk.com/t5/NET/VBA-to-VB-net/td-p/3275489
See the very last post