I would like to know how i could use VB.net to update block attributes.
About 2 years ago I wrote my first small program but have since come to a point I would like to refine and update it. The original was developed in AutoCADs own VBA but I was interested to know if I could achieve the same with VB.net instead?
Below is the original code from 2 years ago, remember the biggest hurdele for me is how to update the attributes in AutoCAD.
Option Explicit
Private Objexcel As Excel.Application
Private ObjWorkbook As Workbook
Private Sub Frame1_Click()
End Sub
Private Sub UserForm_Initialize()
Dim ObjRange As Range, ObjCell
Dim sFolder As String, sDefSheet As String
Dim iRow_counter As Integer
Dim sDwgFile As String
iRow_counter = 0
'Check of de ACAD-tekening reeds is opgeslagen..
sFolder = fGetDefinitionSheetPath(AcadApplication.ActiveDocument.FullName)
If sFolder <> "" Then
'Bepaal de naam van het definitie-bestand bij de betreffende tekening..
sDefSheet = Left$(AcadApplication.ActiveDocument.Name, _
InStrRev(AcadApplication.ActiveDocument.Name, ".")) & DEF_SHEET_EXT
sDefSheet = sFolder & "\" & sDefSheet
'Check op aanwezigheid van Excel-definitionsheet..
If Not fExistsDefinitionSheet(sDefSheet) Then
'Kopieer het standaard definitionsheet..
Call fCopyDefinitionSheet(sDefSheet)
End If
'Openen van Excel...
Set Objexcel = CreateObject("Excel.Application")
Objexcel.Visible = False
Set ObjWorkbook = Objexcel.Workbooks.Open(sDefSheet)
'Selecteren van de in Excel gedefinieerde range met de naam "Artikelinhoud"...
Set ObjRange = ObjWorkbook.Names("Artikelinhoud").RefersToRange
For Each ObjCell In ObjRange
'Vullen van ComboBox met: Inhoudarticle , stored_count
ComboBox1.AddItem ObjCell.Value
'In Column "2" het aantal elementen (stored_count) plaatsen:
ComboBox1.Column(1, iRow_counter) = ObjWorkbook.Worksheets(3).Cells(ObjCell.Row, 3) + 1
iRow_counter = iRow_counter + 1
Next
'Vullen van Algemene informatie...
TextBox1 = ObjWorkbook.Worksheets(1).Cells(1, 1)
TextBox2 = ObjWorkbook.Worksheets(1).Cells(2, 1)
TextBox3 = ObjWorkbook.Worksheets(1).Cells(3, 1)
'''TextBox4 = ObjWorkbook.Worksheets(1).Cells(4, 1)
TextBox5 = ObjWorkbook.Worksheets(1).Cells(2, 2)
TextBox7 = ObjWorkbook.Worksheets(1).Cells(2, 3)
ObjWorkbook.Worksheets(3).Cells(31, 3).Value = "0"
'ComboBox krijgt de eerste waarde uit de lijst...
ComboBox1.ListIndex = 0
'Opvragen van de tweede column "stored_count" uit de ComboBox1 als volgt:
If ComboBox1.ListIndex >= 0 Then TextBox6 = ComboBox1.Column(1)
'Set the focus to Textbox1 and highlight the text...
UserForm1.TextBox1.SetFocus
UserForm1.TextBox1.SelStart = 0
UserForm1.TextBox1.SelLength = Len(UserForm1.TextBox1.Text)
Else
Call MsgBox("Sla eerst uw tekening op in de projectmap, daarna kunt u kaders toevoegen!", vbExclamation + vbOKOnly, Me.Caption)
Unload UserForm1
sDwgFile = ShowSave("Drawing Files (*.dwg)" + Chr$(0) + "*.dwg" + Chr$(0) + _
"All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0), _
DEF_FOLDER_DRAWINGS, "Save DWG as file")
If sDwgFile <> "" Then
Call AcadApplication.ActiveDocument.SaveAs(sDwgFile)
End If
End If
End Sub
Private Sub UserForm_Terminate()
''''This command queues the launch of the 'Layout Wizard' dialog
''' ThisDrawing.SendCommand ("(command ""_DATALINKUPDATE"")" & vbCr)
''' ' This command queues the second part of the macro
''' ThisDrawing.SendCommand ("(command ""U"" ""K"")" & vbCr)
'Imitate as it already saved...
ObjWorkbook.Saved = True
'sluit excel en leeg het geheugen...
ObjWorkbook.Close
Objexcel.Quit
Set ObjWorkbook = Nothing
Set Objexcel = Nothing
End Sub
Private Sub ComboBox1_Change()
'Als er iets geselecteerd wordt, dan... Initieel wordt dit event ook uitgevoerd!!
If ComboBox1.ListIndex >= 0 Then
TextBox6 = ComboBox1.Column(1)
Label8.Visible = True
End If
End Sub
Private Sub CommandButton2_Click()
Unload UserForm1
End Sub
Private Sub CommandButton3_Click()
' Akkoord wanneer het een nieuw kader betreft!..
Dim objBlock As AcadBlock
Dim objBlockRef As AcadBlockReference
Dim InsertionPnt As Variant
Dim Atts As Variant
Dim i As Integer
Dim ObjWorksheet As Worksheet
Dim ObjRange As Range
Dim intNewRow As Integer
Dim strNewCell As String
Dim ftw As String
UserForm1.Hide
Set ObjWorksheet = ObjWorkbook.Worksheets(1)
ObjWorksheet.Cells(1, 1).Value = TextBox1.Text
ObjWorksheet.Cells(2, 1).Value = TextBox2.Text
ObjWorksheet.Cells(3, 1).Value = TextBox3.Text
'''ObjWorksheet.Cells(4, 1).Value = TextBox4.Text
ObjWorksheet.Cells(2, 2).Value = TextBox5.Text
ObjWorksheet.Cells(2, 3).Value = TextBox7.Text
Set ObjWorksheet = ObjWorkbook.Worksheets(2)
ObjWorksheet.Cells(26, 1).Value = ComboBox1.Text
Set ObjWorksheet = ObjWorkbook.Worksheets(4)
Set ObjRange = ObjWorksheet.UsedRange
intNewRow = ObjRange.SpecialCells(xlCellTypeLastCell).Row + 1
strNewCell = "A" & intNewRow
ObjWorksheet.UsedRange.Cells(intNewRow).Value = ComboBox1
Objexcel.DisplayAlerts = False
ObjWorkbook.Save
Set ObjWorksheet = Nothing
InsertionPnt = ThisDrawing.Utility.GetPoint(, "Selecteer het startpunt:")
Set objBlockRef = ThisDrawing.ModelSpace.InsertBlock(InsertionPnt, "C:\ICT\AutoCAD_2010\Customisations\20090409\A-3V.dwg", 1, 1, 1, 0)
'Sets template scale...
ftw = ObjWorkbook.Worksheets(2).Cells(32, 3).Text
objBlockRef.XScaleFactor = ftw
objBlockRef.YScaleFactor = ftw
objBlockRef.ZScaleFactor = ftw
If objBlockRef.HasAttributes Then
Atts = objBlockRef.GetAttributes
For i = LBound(Atts) To UBound(Atts)
Select Case (Atts(i).TagString)
Case "ONDERDEEL" ''the name of your attribute
Atts(i).TextString = ComboBox1.Text
Case "BLADNUMMER"
Atts(i).TextString = ObjWorkbook.Worksheets(2).Cells(54, 12)
Case "WERKNUMMER"
Atts(i).TextString = ObjWorkbook.Worksheets(1).Cells(1, 1)
Case "TEKENAAR"
Atts(i).TextString = ObjWorkbook.Worksheets(1).Cells(2, 1)
Case "DATUM"
Atts(i).TextString = ObjWorkbook.Worksheets(1).Cells(2, 2)
Case "VERDIEPING"
Atts(i).TextString = ObjWorkbook.Worksheets(1).Cells(2, 3)
Case "PROJECT"
Atts(i).TextString = ObjWorkbook.Worksheets(1).Cells(3, 1)
'Case "STATUS"
'Atts(i).TextString = ObjWorkbook.Worksheets(1).Cells(4, 1)
End Select
objBlockRef.Update
Next
End If
Unload UserForm1
End Sub
