HI,
Using VBA, how I get attributes tag name from a block with attributes.
I need to get and set as well.
Thank you in advance if anybody knows to do it un IntelliCAD v.11
I have the same routine in AutoCAD VBA and work fine. See below part of the code in AutoCAD 2022:
If objElem.HasAttributes Then
Array1 = objElem.GetAttributes
For intCount = LBound(Array1) To UBound(Array1)
If (Array1(intCount).EntityName) = "AcDbAttribute" Then
If strNew = "NEW" Then
If Array1(intCount).TagString = "CONTRACTNUMBER" Then
If frmNewproject.txtContractnumber.Text <> "" Then Array1(intCount).TextString = frmNewproject.txtContractnumber.Text
Re: Block Attrubutes
#2Hi,
Maybe have a bug with getting/setting attributes using VBA now.
I also can't get/set an attribute value.
Regards.
Maybe have a bug with getting/setting attributes using VBA now.
I also can't get/set an attribute value.
Regards.
Re: Block Attrubutes
#3Hi, thank you.
I figured out how to set block attributes.
Below is my code, in case help someone.
Private Sub btnDataupdate_Click()
Dim attBts As IntelliCAD.Attributes
Dim ent As Object
Dim intCount, lay As Integer
'Dim cLayout As String
'Me.Hide
On Error Resume Next
For lay = 0 To ActiveDocument.Layouts.Count - 1
If ActiveDocument.Layouts.Item(lay).Name = "Model" Then
For Each ent In ActiveDocument.ModelSpace
If ent.EntityName = "BlockInsert" Then
If ent.Name = "Project Data" Then
If ent.HasAttributes Then
Set attBts = ent.GetAttributes
For intCount = 0 To attBts.Count - 1
If attBts(intCount).TagString = "REP_EMAIL" Then
attBts(intCount).TextString = frmProjectdata.repEmail.Text
End If
If attBts(intCount).TagString = "SALESPERSON" Then
attBts(intCount).TextString = frmProjectdata.txtSalesperson.Text
End If
If attBts(intCount).TagString = "DATE" Then
attBts(intCount).TextString = frmProjectdata.txtDate.Text
End If
If attBts(intCount).TagString = "DRAFTER" Then
attBts(intCount).TextString = frmProjectdata.txtDrafter.Text
End If
If attBts(intCount).TagString = "ZIPCODE" Then
attBts(intCount).TextString = frmProjectdata.txtZipcode.Text
End If
If attBts(intCount).TagString = "APARTMENT" Then
attBts(intCount).TextString = frmProjectdata.txtApartment.Text
End If
If attBts(intCount).TagString = "ADDRESS" Then
attBts(intCount).TextString = frmProjectdata.txtAddress.Text
End If
If attBts(intCount).TagString = "CONTRACT-NAME" Then
attBts(intCount).TextString = frmProjectdata.txtContractname.Text
End If
If attBts(intCount).TagString = "CONTRACTNUMBER" Then
attBts(intCount).TextString = frmProjectdata.txtContractnumber.Text
End If
If attBts(intCount).TagString = "REV1" Then
attBts(intCount).TextString = frmProjectdata.RevBox1.Text
End If
If attBts(intCount).TagString = "REV2" Then
attBts(intCount).TextString = frmProjectdata.RevBox2.Text
End If
If attBts(intCount).TagString = "REV3" Then
attBts(intCount).TextString = frmProjectdata.RevBox3.Text
End If
If attBts(intCount).TagString = "REV4" Then
attBts(intCount).TextString = frmProjectdata.RevBox4.Text
End If
If attBts(intCount).TagString = "REV5" Then
attBts(intCount).TextString = frmProjectdata.RevBox5.Text
End If
If attBts(intCount).TagString = "REV6" Then
attBts(intCount).TextString = frmProjectdata.RevBox6.Text
End If
If attBts(intCount).TagString = "SET" Then
If frmProjectdata.Dset1.Value = True Then attBts(intCount).TextString = "Drawing"
If frmProjectdata.ISet1.Value = True Then attBts(intCount).TextString = "Installation"
If frmProjectdata.RSet1.Value = True Then attBts(intCount).TextString = "Record Set"
End If
If attBts(intCount).TagString = "SHEETS" Then
attBts(intCount).TextString = frmProjectdata.Stotalbox.Text
End If
Next intCount
End If
End If
End If
Next ent
End If
Next lay
Call UpdateSheetData ''Update data of all sheets
ActiveDocument.Regen
MsgBox ("Project Data Updated ...")
'Me.Show
regards,
End Sub '' End Update project data
I figured out how to set block attributes.
Below is my code, in case help someone.
Private Sub btnDataupdate_Click()
Dim attBts As IntelliCAD.Attributes
Dim ent As Object
Dim intCount, lay As Integer
'Dim cLayout As String
'Me.Hide
On Error Resume Next
For lay = 0 To ActiveDocument.Layouts.Count - 1
If ActiveDocument.Layouts.Item(lay).Name = "Model" Then
For Each ent In ActiveDocument.ModelSpace
If ent.EntityName = "BlockInsert" Then
If ent.Name = "Project Data" Then
If ent.HasAttributes Then
Set attBts = ent.GetAttributes
For intCount = 0 To attBts.Count - 1
If attBts(intCount).TagString = "REP_EMAIL" Then
attBts(intCount).TextString = frmProjectdata.repEmail.Text
End If
If attBts(intCount).TagString = "SALESPERSON" Then
attBts(intCount).TextString = frmProjectdata.txtSalesperson.Text
End If
If attBts(intCount).TagString = "DATE" Then
attBts(intCount).TextString = frmProjectdata.txtDate.Text
End If
If attBts(intCount).TagString = "DRAFTER" Then
attBts(intCount).TextString = frmProjectdata.txtDrafter.Text
End If
If attBts(intCount).TagString = "ZIPCODE" Then
attBts(intCount).TextString = frmProjectdata.txtZipcode.Text
End If
If attBts(intCount).TagString = "APARTMENT" Then
attBts(intCount).TextString = frmProjectdata.txtApartment.Text
End If
If attBts(intCount).TagString = "ADDRESS" Then
attBts(intCount).TextString = frmProjectdata.txtAddress.Text
End If
If attBts(intCount).TagString = "CONTRACT-NAME" Then
attBts(intCount).TextString = frmProjectdata.txtContractname.Text
End If
If attBts(intCount).TagString = "CONTRACTNUMBER" Then
attBts(intCount).TextString = frmProjectdata.txtContractnumber.Text
End If
If attBts(intCount).TagString = "REV1" Then
attBts(intCount).TextString = frmProjectdata.RevBox1.Text
End If
If attBts(intCount).TagString = "REV2" Then
attBts(intCount).TextString = frmProjectdata.RevBox2.Text
End If
If attBts(intCount).TagString = "REV3" Then
attBts(intCount).TextString = frmProjectdata.RevBox3.Text
End If
If attBts(intCount).TagString = "REV4" Then
attBts(intCount).TextString = frmProjectdata.RevBox4.Text
End If
If attBts(intCount).TagString = "REV5" Then
attBts(intCount).TextString = frmProjectdata.RevBox5.Text
End If
If attBts(intCount).TagString = "REV6" Then
attBts(intCount).TextString = frmProjectdata.RevBox6.Text
End If
If attBts(intCount).TagString = "SET" Then
If frmProjectdata.Dset1.Value = True Then attBts(intCount).TextString = "Drawing"
If frmProjectdata.ISet1.Value = True Then attBts(intCount).TextString = "Installation"
If frmProjectdata.RSet1.Value = True Then attBts(intCount).TextString = "Record Set"
End If
If attBts(intCount).TagString = "SHEETS" Then
attBts(intCount).TextString = frmProjectdata.Stotalbox.Text
End If
Next intCount
End If
End If
End If
Next ent
End If
Next lay
Call UpdateSheetData ''Update data of all sheets
ActiveDocument.Regen
MsgBox ("Project Data Updated ...")
'Me.Show
regards,
End Sub '' End Update project data
Re: Block Attrubutes
#4Hi, thank you.
I figured out how to set block attributes.
Below is my code, in case help someone.
Private Sub btnDataupdate_Click()
Dim attBts As IntelliCAD.Attributes
Dim ent As Object
Dim intCount, lay As Integer
'Dim cLayout As String
'Me.Hide
On Error Resume Next
For lay = 0 To ActiveDocument.Layouts.Count - 1
If ActiveDocument.Layouts.Item(lay).Name = "Model" Then
For Each ent In ActiveDocument.ModelSpace
If ent.EntityName = "BlockInsert" Then
If ent.Name = "Project Data" Then
If ent.HasAttributes Then
Set attBts = ent.GetAttributes
For intCount = 0 To attBts.Count - 1
If attBts(intCount).TagString = "REP_EMAIL" Then
attBts(intCount).TextString = frmProjectdata.repEmail.Text
End If
If attBts(intCount).TagString = "SALESPERSON" Then
attBts(intCount).TextString = frmProjectdata.txtSalesperson.Text
End If
If attBts(intCount).TagString = "DATE" Then
attBts(intCount).TextString = frmProjectdata.txtDate.Text
End If
If attBts(intCount).TagString = "DRAFTER" Then
attBts(intCount).TextString = frmProjectdata.txtDrafter.Text
End If
If attBts(intCount).TagString = "ZIPCODE" Then
attBts(intCount).TextString = frmProjectdata.txtZipcode.Text
End If
If attBts(intCount).TagString = "APARTMENT" Then
attBts(intCount).TextString = frmProjectdata.txtApartment.Text
End If
If attBts(intCount).TagString = "ADDRESS" Then
attBts(intCount).TextString = frmProjectdata.txtAddress.Text
End If
If attBts(intCount).TagString = "CONTRACT-NAME" Then
attBts(intCount).TextString = frmProjectdata.txtContractname.Text
End If
If attBts(intCount).TagString = "CONTRACTNUMBER" Then
attBts(intCount).TextString = frmProjectdata.txtContractnumber.Text
End If
If attBts(intCount).TagString = "REV1" Then
attBts(intCount).TextString = frmProjectdata.RevBox1.Text
End If
If attBts(intCount).TagString = "REV2" Then
attBts(intCount).TextString = frmProjectdata.RevBox2.Text
End If
If attBts(intCount).TagString = "REV3" Then
attBts(intCount).TextString = frmProjectdata.RevBox3.Text
End If
If attBts(intCount).TagString = "REV4" Then
attBts(intCount).TextString = frmProjectdata.RevBox4.Text
End If
If attBts(intCount).TagString = "REV5" Then
attBts(intCount).TextString = frmProjectdata.RevBox5.Text
End If
If attBts(intCount).TagString = "REV6" Then
attBts(intCount).TextString = frmProjectdata.RevBox6.Text
End If
If attBts(intCount).TagString = "SET" Then
If frmProjectdata.Dset1.Value = True Then attBts(intCount).TextString = "Drawing"
If frmProjectdata.ISet1.Value = True Then attBts(intCount).TextString = "Installation"
If frmProjectdata.RSet1.Value = True Then attBts(intCount).TextString = "Record Set"
End If
If attBts(intCount).TagString = "SHEETS" Then
attBts(intCount).TextString = frmProjectdata.Stotalbox.Text
End If
Next intCount
End If
End If
End If
Next ent
End If
Next lay
Call UpdateSheetData ''Update data of all sheets
ActiveDocument.Regen
MsgBox ("Project Data Updated ...")
'Me.Show
End Sub '' End Update project data
regards,
P.D.
Instead of 'If' statement you can use 'Select Case' statement
I figured out how to set block attributes.
Below is my code, in case help someone.
Private Sub btnDataupdate_Click()
Dim attBts As IntelliCAD.Attributes
Dim ent As Object
Dim intCount, lay As Integer
'Dim cLayout As String
'Me.Hide
On Error Resume Next
For lay = 0 To ActiveDocument.Layouts.Count - 1
If ActiveDocument.Layouts.Item(lay).Name = "Model" Then
For Each ent In ActiveDocument.ModelSpace
If ent.EntityName = "BlockInsert" Then
If ent.Name = "Project Data" Then
If ent.HasAttributes Then
Set attBts = ent.GetAttributes
For intCount = 0 To attBts.Count - 1
If attBts(intCount).TagString = "REP_EMAIL" Then
attBts(intCount).TextString = frmProjectdata.repEmail.Text
End If
If attBts(intCount).TagString = "SALESPERSON" Then
attBts(intCount).TextString = frmProjectdata.txtSalesperson.Text
End If
If attBts(intCount).TagString = "DATE" Then
attBts(intCount).TextString = frmProjectdata.txtDate.Text
End If
If attBts(intCount).TagString = "DRAFTER" Then
attBts(intCount).TextString = frmProjectdata.txtDrafter.Text
End If
If attBts(intCount).TagString = "ZIPCODE" Then
attBts(intCount).TextString = frmProjectdata.txtZipcode.Text
End If
If attBts(intCount).TagString = "APARTMENT" Then
attBts(intCount).TextString = frmProjectdata.txtApartment.Text
End If
If attBts(intCount).TagString = "ADDRESS" Then
attBts(intCount).TextString = frmProjectdata.txtAddress.Text
End If
If attBts(intCount).TagString = "CONTRACT-NAME" Then
attBts(intCount).TextString = frmProjectdata.txtContractname.Text
End If
If attBts(intCount).TagString = "CONTRACTNUMBER" Then
attBts(intCount).TextString = frmProjectdata.txtContractnumber.Text
End If
If attBts(intCount).TagString = "REV1" Then
attBts(intCount).TextString = frmProjectdata.RevBox1.Text
End If
If attBts(intCount).TagString = "REV2" Then
attBts(intCount).TextString = frmProjectdata.RevBox2.Text
End If
If attBts(intCount).TagString = "REV3" Then
attBts(intCount).TextString = frmProjectdata.RevBox3.Text
End If
If attBts(intCount).TagString = "REV4" Then
attBts(intCount).TextString = frmProjectdata.RevBox4.Text
End If
If attBts(intCount).TagString = "REV5" Then
attBts(intCount).TextString = frmProjectdata.RevBox5.Text
End If
If attBts(intCount).TagString = "REV6" Then
attBts(intCount).TextString = frmProjectdata.RevBox6.Text
End If
If attBts(intCount).TagString = "SET" Then
If frmProjectdata.Dset1.Value = True Then attBts(intCount).TextString = "Drawing"
If frmProjectdata.ISet1.Value = True Then attBts(intCount).TextString = "Installation"
If frmProjectdata.RSet1.Value = True Then attBts(intCount).TextString = "Record Set"
End If
If attBts(intCount).TagString = "SHEETS" Then
attBts(intCount).TextString = frmProjectdata.Stotalbox.Text
End If
Next intCount
End If
End If
End If
Next ent
End If
Next lay
Call UpdateSheetData ''Update data of all sheets
ActiveDocument.Regen
MsgBox ("Project Data Updated ...")
'Me.Show
End Sub '' End Update project data
regards,
P.D.
Instead of 'If' statement you can use 'Select Case' statement