TheSwamp
Code Red => VB(A) => Topic started by: gunnahdo on June 17, 2004, 07:38:50 PM
-
I am having trouble with a vba to update an individual blocks attributes,
you pick tha ansewrs for existing data in the drawing I am testing for acadblock block name then the correct block attribute hence then update (I have 11 attributes in block)
I can not see where I am going wrong some of the lineses have been cut out to make email shorter a fresh set of eye may see the obvious, I had it working but found problems outside of test dwg so I know the code is 99%
Public Sub ModifyPitSchedule4()
' puts in 2 Pts x and y
Dim SS As AcadSelectionSet
'Dim objENT As AcadEntity
Dim Count As Integer
Dim val, pitname As String
Dim PitNameSelect As AcadObject
Dim basepnt, pt1, pt2, pt3 As Variant
Dim attribs As Variant
On Error Resume Next
Set SS = ThisDrawing.SelectionSets.Add("MYSS2")
SS.Select acSelectionSetAll
val = "SCHEDTEXT" ' this is block name
ThisDrawing.Utility.GetEntity PitNameSelect, basepnt, "pick pit name : "
If PitNameSelect.ObjectName = "AcDbText" Then
pitname = PitNameSelect.TextString
MsgBox "pitname selected is " & pitname
End If
If PitNameSelect.ObjectName = "AcDbBlockReference" Then
pitblname = PitNameSelect.Name ' RETURNS BLOCK NAME
attribs = PitNameSelect.GetAttributes
pitname = attribs(0).TextString
MsgBox "pitname selected is " & pitname
End If
code here ok !!!!! lines removed for forum
pt1 = ThisDrawing.Utility.GetPoint(, " pick first point")
pt2 = ThisDrawing.Utility.GetPoint(, " pick 2nd point L ")
pt3 = ThisDrawing.Utility.GetPoint(, " pick 3rd point W ")
lengthpit = CStr(FormatNumber(lz, 0))
widthpit = CStr(FormatNumber(lz, 0))
code starts here again
For i = 1 To SS.Count
Set objENT = SS(i)
If objENT.EntityName = "AcDbBlockReference" Then
attribs = objENT.GetAttributes
MsgBox "1 ATTRIB name IS " & objENT.EntityName & "......" & objENT.Name & "......" & attribs(0).TextString
' NOT GOING IN HERE RETURNS BLOCK NAME
If objENT.Name = val Then ' this does not work
' attribs = objENT.GetAttributes
MsgBox "2 block name IS " & objENT.Name & "......" & i & "......" & attribs(0).TextString
'this finds blocks
If attribs(0).TextString = pitname Then
' update attribute values here.
attribs(1).TextString = txtx1
attribs(2).TextString = txty1
attribs(3).TextString = txtx2
attribs(4).TextString = txty2
attribs(5).TextString = lengthpit
attribs(6).TextString = widthpit
attribs(1).update
attribs(2).update etc etc
end all ifs etc
-
I'm pretty busy at the moment and don't really have the time to investigate your routine enough but this may help. I use this to set the attribute value in a block from a textbox value.
If you already know the block name, why not just filter your selection for it ?
Private Sub UpdateBlock_Click()
Dim BlkNm As AcadBlockReference
Dim BlkAtts As Variant
Dim FW As String
FW = TextFW.Value
Set SSetCol = ThisDrawing.SelectionSets
For Each SSet1 In SSetCol
If SSet1.Name = "SS1" Then
ThisDrawing.SelectionSets.Item("SS1").Delete
Exit For
End If
Next
Mode = acSelectionSetAll
Set SSet1 = ThisDrawing.SelectionSets.Add("SS1")
Dim FilterType(0 To 1) As Integer
Dim FilterData(0 To 1) As Variant
FilterType(0) = 0: FilterData(0) = "INSERT"
FilterType(1) = 2: FilterData(1) = "FW*"
SSet1.Select Mode, , , FilterType, FilterData
For Each BlkNm In SSet1
BlkAtts = BlkNm.GetAttributes
BlkAtts(0).TextString = Format(FW, "#0") & " %%P2"
Next
ThisDrawing.Regen acActiveViewport
Unload Me
End Sub