Jump to content

Block Attributes

dave buckberry

By dave buckberry
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

dave buckberry Rookie

dave buckberry

Posted
Posted

Can Anyone Help I have 1500 Blocks on a drawing i need some help in changing all of the tags in the blocks that have the same name ie: chair to chair2 the update the block with vba their are only 4 tags in the blocks and the name to change could be in any of the tags i have counted the block on the screen and have there block names but i just can't update the block can anyone help this is the code that i have

 

 

Private Function GetAttributes() As Collection

Dim i As Integer

 

Dim objBlock As acadBlock

Dim AttObj As AcadAttribute

Dim Tag As String

Dim Value As String

 

Dim oEnt As AcadEntity

For i = 0 To Me.lstDestination.ListCount - 1

For Each objBlock In ThisDrawing.Blocks

If objBlock.name = lstDestination.List(i) Then

Set objBlock = ThisDrawing.Blocks.Item(Me.lstDestination.List(i))

For Each oEnt In objBlock

If TypeOf oEnt Is AcadAttribute Then

Set AttObj = oEnt

If AttObj.TagString = "TYPE" Then

If AttObj.TextString = TxtOldTagName Then

Value = TxtNewTagName

AttObj.Update

 

Debug.Print AttObj.TagString

Debug.Print Tag

Debug.Print Value

End If

End If

End If

Next oEnt

End If

Next objBlock

Next i

 

End Function

Lee Mac Grand Master

Lee Mac

Posted
Posted

In LISP, it would be something like this:

 

(defun c:tagchng (/ nTag oTag ss ssl bCnt bEnt aEnt aEntlist)
   (while (or (not nTag)
          (not oTag)
      ) ;_  end or
   (setq oTag (getstring "\nReplace: ")
         nTag (getstring "\nWith: ")
   ) ;_  end setq
   ) ;_  end while
   (if
   (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 410 (getvar "ctab")))))
      (progn
          (setq ssl  (1- (sslength ss))
            bCnt 0
          ) ;_  end setq
          (while (not (minusp ssl))
          (setq bEnt (ssname ss ssl))
          (if (setq aEnt (entnext bEnt))
              (progn
              (setq aEntlist (entget aEnt))
              (if (= (cdr (assoc 2 aEntlist)) oTag)
                  (progn
                  (setq aEntlist (subst (cons 2 nTag) (assoc 2 aEntlist) aEntlist))
                  (entmod aEntlist)
                  (setq bCnt (1+ bCnt))
                  ) ;_  end progn
              ) ;_  end if
              ) ;_  end progn
          ) ;_  end if
          (setq ssl (1- ssl))
          ) ;_  end while
      ) ;_  end progn
      (princ "\n<!> No Blocks Found <!>")
   ) ;_  end if
   (princ (strcat "\n" (rtos bCnt 2 0) " Block Attribute Tags Modified."))
   (princ)
) ;_  end defun

Raggi_Thor Community Regular

Raggi_Thor

Posted
Posted

In VBA you must look at the BlockReferences in ModelSpace (or PaperSpace).

Attributes are a bit special, they are not updated in the references when you change the block definition.

 

Something like

For each obj in thisdraing.modelspace

 

and

If obj.entityname = acdbblockreference then

 

Set varAtts = obj.GetAttributes

Lee Mac Grand Master

Lee Mac

Posted
Posted

With numerous replacements:

 

(defun c:tagchng (/ nTag oTag AssLst TagLst ss ssl bCnt bEnt aEnt aEntlist)
   (while (or (not nTag)
          (/= nTag "")
          (not oTag)
          (/= oTag "")
      ) ;_  end or
   (setq oTag (getstring "\nReplace: ")
         nTag (getstring "\nWith: ")
   ) ;_  end setq
   (setq AssLst (list oTag nTag))
   (setq TagLst (cons AssLst TagLst)
   ) ;_  end setq
   ) ;_  end while
   (setq TagLst (cdr TagLst))
   (if
   (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 410 (getvar "ctab")))))
      (progn
          (setq bCnt 0)
          (foreach    tag TagLst
          (setq ssl (1- (sslength ss)))
          (while (not (minusp ssl))
              (setq bEnt (ssname ss ssl))
              (if (setq aEnt (entnext bEnt))
              (progn
                  (setq aEntlist (entget aEnt))
                  (if (= (cdr (assoc 2 aEntlist)) (car tag))
                  (progn
                      (setq aEntlist (subst (cons 2 (cadr tag)) (assoc 2 aEntlist) aEntlist))
                      (entmod aEntlist)
                      (setq bCnt (1+ bCnt))
                  ) ;_  end progn
                  ) ;_  end if
              ) ;_  end progn
              ) ;_  end if
              (setq ssl (1- ssl))
          ) ;_  end while
          ) ;_  end foreach
      ) ;_  end progn
      (princ "\n<!> No Blocks Found <!>")
   ) ;_  end if
   (princ (strcat "\n" (rtos bCnt 2 0) " Block Attribute Tags Modified."))
   (princ)
) ;_  end defun

David Bethel Grand Master

David Bethel

Posted
Posted

Dave,

 

I'm assuming from the thread's title that you want to change the INSERT ATTRIBute string values, not the BLOCK ATTDEF Tag names. They are 2 very different things.

 

I guessed that the old string value is not case sensitive and that spaces are allowed. And that empty strings as acceptable. Also that the new value's string case will be inputted correctly.

 

[b][color=BLACK]([/color][/b]defun c:chg-att [b][color=FUCHSIA]([/color][/b]/ ov nv ss i en an ad[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]not ov[b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq ov [b][color=MAROON]([/color][/b]getstring t [color=#2f4f4f]"\nOld ATTRIB Value:   "[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]not nv[b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq nv [b][color=MAROON]([/color][/b]getstring t [color=#2f4f4f]"\nNew ATTRIB Value:   "[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget [color=#2f4f4f]"X"[/color] [b][color=GREEN]([/color][/b]list [b][color=BLUE]([/color][/b]cons 0 [color=#2f4f4f]"INSERT"[/color][b][color=BLUE])[/color][/b]
                                [b][color=BLUE]([/color][/b]cons 66 1[b][color=BLUE])[/color][/b]
                                [b][color=BLUE]([/color][/b]if [b][color=RED]([/color][/b]getvar [color=#2f4f4f]"CTAB"[/color][b][color=RED])[/color][/b]
                                    [b][color=RED]([/color][/b]cons 410 [b][color=PURPLE]([/color][/b]getvar [color=#2f4f4f]"CTAB"[/color][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
                                    [b][color=RED]([/color][/b]cons 67 [b][color=PURPLE]([/color][/b]- 1 [b][color=TEAL]([/color][/b]getvar [color=#2f4f4f]"TILEMODE"[/color][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
       [b][color=NAVY]([/color][/b]setq i [b][color=MAROON]([/color][/b]sslength ss[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
       [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]not [b][color=GREEN]([/color][/b]minusp [b][color=BLUE]([/color][/b]setq i [b][color=RED]([/color][/b]1- i[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
              [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss i[b][color=GREEN])[/color][/b]
                    an [b][color=GREEN]([/color][/b]entnext en[b][color=GREEN])[/color][/b]
                    ad [b][color=GREEN]([/color][/b]entget an[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
              [b][color=MAROON]([/color][/b]while [b][color=GREEN]([/color][/b]/= [color=#2f4f4f]"SEQEND"[/color] [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 0 ad[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                     [b][color=GREEN]([/color][/b]and [b][color=BLUE]([/color][/b]= [b][color=RED]([/color][/b]strcase ov[b][color=RED])[/color][/b]
                             [b][color=RED]([/color][/b]strcase [b][color=PURPLE]([/color][/b]cdr [b][color=TEAL]([/color][/b]assoc 1 ad[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                          [b][color=BLUE]([/color][/b]entmod [b][color=RED]([/color][/b]subst [b][color=PURPLE]([/color][/b]cons 1 nv[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]assoc 1 ad[b][color=PURPLE])[/color][/b] ad[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                          [b][color=BLUE]([/color][/b]entupd en[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                     [b][color=GREEN]([/color][/b]setq an [b][color=BLUE]([/color][/b]entnext an[b][color=BLUE])[/color][/b]
                           ad [b][color=BLUE]([/color][/b]entget an[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

-David

Lee Mac Grand Master

Lee Mac

Posted
Posted

What is the "SEQEND" David?, Also, why set TILEMODE as a restriction?

 

To be honest, I did wonder why he wanted to change Attribute Definition Values, but followed his request and created the LISP, but I think Attribute String values is more likely.

David Bethel Grand Master

David Bethel

Posted
Posted

A SEQEND is the last entity in an ATTRIButed INSERT or a HEAVYweight ( old style ) POLYLINE. It tells you when you are done with the sequential entities.

 

CTAB was introduced in AutoCAD 2000. Before that we only had modelspace/paperspace entities ( dxf group 67 ). -David

Lee Mac Grand Master

Lee Mac

Posted
Posted

Ahh, I understand it now:

 

so, you are accounting for every version of ACAD - nice.

Lee Mac Grand Master

Lee Mac

Posted
Posted

This same task could just be accomplished using the Find and Replace tool in ACAD. (If indeed it is the Attribute String values that need changing and not the Attribute Tag Definitions...)

Raggi_Thor Community Regular

Raggi_Thor

Posted
Posted

I knew I had seen this problem before :)

This is what I did for a customer a few months ago!

My memory is good, but short..

 

Getting all tags:

 

Private Sub ddGetAllTags()
   Dim att As AcadAttributeReference
   Dim atts As Variant
   Dim blk As AcadBlockReference
   Dim obj As AcadEntity
   Dim i As Integer, j As Integer
   tags = ""
   For Each obj In ActiveDocument.ModelSpace
       If obj.EntityName = "AcDbBlockReference" Then
           Set blk = obj
           If blk.HasAttributes Then
               atts = blk.GetAttributes
               For i = LBound(atts) To UBound(atts)
                   Set att = atts(i)
                   If InStr(tags, att.TagString) = 0 Then
                       tags = tags & "TAG:" & att.TagString & vbCr
                       ReDim Preserve MyArray(j) As String
                       MyArray(j) = att.TagString
                       'Debug.Print j & " : " & att.TagString
                       j = j + 1
                   End If
               Next i
           End If
       End If
   Next
End Sub

 

 

Renaming them, according to text in dialog box (see image):

Private Sub ddRenameAllTags()
   Dim i As Integer
   For i = 0 To UBound(MyArray)
       'If Len(Controls(MyArray(i)).Value) > 0 Then
           'Debug.Print i & " : " & MyArray(i) & " -> " & Controls(MyArray(i)).Value
           tags = tags & "TAG:" & Controls(MyArray(i)).Name & ","
           If InStr(Controls(MyArray(i)), " ") > 0 Then
               MsgBox "Tags may not contain spaces.", vbCritical, MyApp
               Controls(MyArray(i)).SetFocus
               'Controls(MyArray(i)).SelectAll
               Exit Sub
           End If
           If Me.chkSave Then
              SaveSetting MyApp, MySec, Controls(MyArray(i)).Name, Controls(MyArray(i))
           End If
       'End If
   Next i
   If Len(tags) > 0 Then

   Dim att As AcadAttributeReference
   Dim atts As Variant
   Dim blk As AcadBlockReference
   Dim obj As AcadEntity
   For Each obj In ActiveDocument.ModelSpace
       If obj.EntityName = "AcDbBlockReference" Then
           Set blk = obj
           If blk.HasAttributes Then
               atts = blk.GetAttributes
               For i = LBound(atts) To UBound(atts)
                   Set att = atts(i)
                   If InStr(tags, "TAG:" & att.TagString) > 0 Then
                       If Len(Controls(att.TagString).Value) > 0 Then
                           att.TagString = (Controls(att.TagString).Value)
                       End If
                   End If
               Next i
           End If
       End If
   Next
   
   
   End If
   End 'close dialog
End Sub

ddRenameTagsDialog.jpg

ddRenameTags (2).zip

Raggi_Thor Community Regular

Raggi_Thor

Posted
Posted

It's a Visual BAsic file for AutoCAD, Visual Basic for Applications, VBA.

 

Use APPLOAD or VBALOAD to load it.

Use VBARUN to acticate the macro.

 

I normaly use a mnu file to make a menu and a mnl file (menu lisp) that is loaded automatically with the manu, and in there I put some lips to define the command:

 

(defun ddRenameTags()
   (command)
   (command "-vbarun" "ddRenameTags.dvb!ddRenameTags")
   (princ)
)



;Add aliases as you like:

(defun c:rent()
   (ddRenameTags)
)

(defun c:rt()
   (ddRenameTags)
)

(defun c:RenameTags()
   (ddRenameTags)
)

 

The line

(command "-vbarun" "ddRenameTags.dvb!ddRenameTags")

will load the dvb file and activate the macro (sub).

Raggi_Thor Community Regular

Raggi_Thor

Posted
Posted

And good night to you :)

A few minutes past midnight here, work tomorrow..

Raggi_Thor Community Regular

Raggi_Thor

Posted
Posted

Forgot, how do you make them

 

Menues in ac2009? No Idea!

 

Command: VBAIDE takes you to the VBA editor.

Shortcut: Alt + F11

Lee Mac Grand Master

Lee Mac

Posted
Posted
Forgot, how do you make them

 

Menues in ac2009? No Idea!

 

Command: VBAIDE takes you to the VBA editor.

Shortcut: Alt + F11

 

Excellent Thanks!

 

11:30pm here, I probably should be in bed too - got a 9am lecture tomorrow!

  • 2 months later...
khiraly Newbie

khiraly

Posted
Posted

Hi there!

 

I need to rename lot of blocks' attributes sequentially.

So I have blocks, where the attribute name is 1, 2, 3, 3, 3, 4.

I would like to rename it, by selecting the blocks what I want exactly to rename

and type the start value and the incremental value.

Like:

start value: 3

incremental: 2

The result should be: 3, 5, 7, 9, 11, 13

 

The bonus would be if it could increment the numbers inside a text. Like F1, F2, F3, F3, F3, F4 ->F1, F2, F3, F4, F5, F6

 

Do somebody already faced such a problem?

 

Thank you in advance.

 

Nevermind, I found the right thread which solves my problem.

Such a knowledgable forum. Really helpful by the way.

 

Here is the script's homepage: http://www.asmitools.com/Files/Lisps/Renum.html

With video tutorial, impressive as hell. Foolproof;)

Lee Mac Grand Master

Lee Mac

Posted
Posted
Hi there!

 

I need to rename lot of blocks' attributes sequentially.

So I have blocks, where the attribute name is 1, 2, 3, 3, 3, 4.

I would like to rename it, by selecting the blocks what I want exactly to rename

and type the start value and the incremental value.

Like:

start value: 3

incremental: 2

The result should be: 3, 5, 7, 9, 11, 13

 

The bonus would be if it could increment the numbers inside a text. Like F1, F2, F3, F3, F3, F4 ->F1, F2, F3, F4, F5, F6

 

Do somebody already faced such a problem?

 

Thank you in advance.

 

Nevermind, I found the right thread which solves my problem.

Such a knowledgable forum. Really helpful by the way.

 

Here is the script's homepage: http://www.asmitools.com/Files/Lisps/Renum.html

With video tutorial, impressive as hell. Foolproof;)

 

Can't go wrong with ASMI :thumbsup:

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...