Author Topic: using vba to update block attributes  (Read 4837 times)

0 Members and 1 Guest are viewing this topic.

gunnahdo

  • Guest
using vba to update block attributes
« 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

hendie

  • Guest
using vba to update block attributes
« Reply #1 on: June 18, 2004, 04:00:03 AM »
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 ?


Code: [Select]
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