Page 1 of 1
Block Attrubutes
Posted: Sat Sep 17, 2022 10:52 am
by Jnm226@gmail.com
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
Posted: Mon Sep 19, 2022 2:30 am
by QuanNguyen
Hi,
Maybe have a bug with getting/setting attributes using VBA now.
I also can't get/set an attribute value.
Regards.
Re: Block Attrubutes
Posted: Wed Sep 21, 2022 2:00 pm
by Jnm226@gmail.com
Hi, 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
Re: Block Attrubutes
Posted: Wed Sep 21, 2022 2:03 pm
by Jnm226@gmail.com
Hi, 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