Jump to content

Recommended Posts

Posted

I need to change the attribute of "tag" = "PRO" in all blocks of the model space of the active document in autocad. The text you need to add is "my project".

 

I searched for information about walking blocks and change the attributes but I get nothing. Can anyone help me please?

Posted

thank you very much. I am going to read them.

Posted

Here is some examples to get you started

 

Public Sub ModifyPitSchedule1()
' adds single pt

Dim SS As AcadSelectionSet
Dim objENT As AcadEntity
Dim Count, Cntr As Integer
Dim Newpitname As String
Dim pitname As String
Dim FilterDXFCode(0) As Integer
Dim FilterDXFVal(0) As Variant
Dim PitNameSelect As AcadObject
Dim basepnt, pt1, pt2, pt3 As Variant
Dim attribs As Variant

'On Error Resume Next

Newpitname = "1"   'dummy to pass then return changed
BLOCK_NAME = "SCHEDTEXT"

pitname = Getpitname(Newpitname)

MsgBox "pitname selected is " & pitname

FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"
'FilterDXFCode(1) = 2
'FilterDXFVal(1) = "SCHEDTEXT"

Set SS = ThisDrawing.SelectionSets.Add("pit1sel")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal


For Cntr = 0 To SS.Count - 1

If SS.Item(Cntr).Name = BLOCK_NAME Then

 
  attribs = SS.Item(Cntr).GetAttributes
       
    If attribs(0).TextString = pitname Then
      pt1 = ThisDrawing.Utility.GetPoint(, " pick first point")

      txtx1 = CStr(FormatNumber(pt1(0), 3))
      TXTY1 = CStr(FormatNumber(pt1(1), 3))
       
       attribs(1).TextString = txtx1
       attribs(2).TextString = TXTY1
       
       attribs(1).Update
       attribs(2).Update
'        ThisDrawing.Application.Update
' try this
       Cntr = SS.Count
    
    Else: End If
     
Else: End If

Next Cntr
ThisDrawing.SelectionSets.Item("pit1sel").Delete
End Sub

 

This one allows either a text as the name of the attribute or pick a block

 

Function Getpitname(Newpitname As String) As String

Dim PitNameSelect As AcadObject
Dim pitattribs As Variant


ThisDrawing.Utility.GetEntity PitNameSelect, basepnt, "pick pit name : "
If PitNameSelect.ObjectName = "AcDbText" Then
 Getpitname = PitNameSelect.TextString
End If

If PitNameSelect.ObjectName = "AcDbBlockReference" Then
 pitblname = PitNameSelect.Name   ' RETURNS BLOCK NAME
 pitattribs = PitNameSelect.GetAttributes
 Getpitname = pitattribs(0).TextString

End If


End Function

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.

×
×
  • Create New...