VBA - returning individual attributes to their default text style

[TroutKing]

Hi Everyone,

 

Is someone out there able to help me with this? I am trying to create some code that allows the user to click on one attribute at a time – and each time an attribute is selected its text style resets back to its default.

 

Example – on the attached drawing:

AttributeTest.dwg

Block “CONTACT-8” on the very left side of the drawing has three attributes. The first attribute has had “75” entered. When this attribute is double clicked you can see that under the “Text Options” tab the Text Style has been adjusted. I want to click that particular attribute and have only that attribute go back to its default Text Style (STANDARD in this case.) I do NOT want any of the other attributes to be adjusted. I want only that one to be adjusted and then the user can move on to the next block containing the next attribute they choose to return to its default. I want to continue through the drawing until the user clicks enter twice to end the macro.

 

I’m not really sure how approach this. I began with the code below (which does not work), but I don’t think this is the correct approach after all because it would change all the attributes for the selected block as opposed to just the selected attribute.

 

 
Option Explicit
Public Sub SelectBlockAndUpdateTextStyle()
Dim MyBlock As AcadBlockReference
Dim SelectedBlock As Variant
Dim i As Variant
ThisDrawing.Utility.GetEntity MyBlock, SelectedBlock, "Select object:"

If MyBlock.ObjectName = "AcDbBlockReference" Then
   If MyBlock.HasAttributes Then
       Dim MyBlockAttribute As Variant
       MyBlockAttribute = MyBlock.GetAttributes
       For i = LBound(MyBlockAttribute) To UBound(MyBlockAttribute)
           If Not MyBlockAttribute(i).TextStyle = "STANDARD" Then
           MyBlockAttribute(i).TextStyle = "STANDARD"
           End If
           ThisDrawing.Application.Update
       Next
   End If
Else
   MsgBox "You didn't select an AutoCAD block. Better luck next time."
End If
End Sub

Is there anyone who can help me and point me in the right direction?

 

I definitely appreciate your help

 

Thank you,

Mike

[TroutKing]

Hmmm crickets again.

 

Well either I'm not good at explaining my dilemma(s) or perhaps my questions are uninteresting or/and unsolvable.

 

With a few adjustments I made the code work for an entire block (see below). It will adjust the attributes within the chosen block and set them to their original standard values.

 

However, it adjusts ALL the attributes in the chosen block. I only want to change the attribute that was selected with the cursor.

 

Any ideas out there?

Option Explicit
Public Sub SelectBlockAndUpdateTextStyle()
Dim MyBlock As AcadBlockReference
Dim SelectedBlock As Variant
Dim i As Variant
Dim MyWidth As Integer
MyWidth = 1#
ThisDrawing.Utility.GetEntity MyBlock, SelectedBlock, "Select object:"

If MyBlock.ObjectName = "AcDbBlockReference" Then
   If MyBlock.HasAttributes Then
       Dim MyBlockAttribute As Variant
       MyBlockAttribute = MyBlock.GetAttributes
       For i = LBound(MyBlockAttribute) To UBound(MyBlockAttribute)
           If Not MyBlockAttribute(i).StyleName = "STANDARD" Then
           MyBlockAttribute(i).StyleName = "STANDARD"
           MyBlockAttribute(i).ScaleFactor = MyWidth
           End If
           MyBlockAttribute(i).Update
       Next
   End If
Else
   MsgBox "You didn't select an AutoCAD block. Better luck next time."
End If
End Sub

[fixo]

I've posted the hint on your e-mail,

check it

[BlackBox]

Hmmm crickets again.

 

Well either I'm not good at explaining my dilemma(s) or perhaps my questions are uninteresting or/and unsolvable.

 

Don't take it personal... It is more likely that you're not getting (much?) support, as you're coding in VBA, rather than in Visual LISP, or .NET, methinks.

 

I could be mistaken, as I am not adept at coding VBA, but perhaps using GetSubEntity Method in lieu of GetEntity Method would be advantageous, no?

[TroutKing]

Thanks Oleg I replied to your email

 

Thank you RenderMan. I like that possible solution. I looked into it and will need to work with it, but it may just work for my needs. Thanks!

I realize that I'm going to have to move on to one of the other programming languages. I've been holding out. I'm disappointed in AutoCAD for moving away from a language that has been used for many years and can be used in other applications (i.e. Excel). I know nothing of Visual LISP or .NET. Perhaps they work in other applications as well?

[BlackBox]

Thank you RenderMan. I like that possible solution. I looked into it and will need to work with it, but it may just work for my needs. Thanks!

 

You're welcome; hope it helps.

 

I realize that I'm going to have to move on to one of the other programming languages. I've been holding out. I'm disappointed in AutoCAD for moving away from a language that has been used for many years and can be used in other applications (i.e. Excel). I know nothing of Visual LISP or .NET. Perhaps they work in other applications as well?

 

Well, VBA has been 'dead or dying' through attrition for years, and is no longer supported by MS. Interestingly, however, is that in a recent developer survey the option of VBA7 was listed, though it did not have many votes. So you never know.

 

Visual LISP, while syntactically different than that of VBA, allows one access to both the LISP API, and the ActiveX API (i.e., VBA). I still have access to Document and Application level Objects, and can even interface with external Objects. Too many examples to post them all, but as a small sample set, these include Scripting.FileSystemObject, Shell.Application, WScript.Shell, and even Sapi.SpVoice Objects.

 

More on getting started with .NET development for AutoCAD.

 

HTH

[TroutKing]

Actually that helped a lot. I have some code now that works for what I need. I need to somehow add a "Do Until" user clicks "ENTER" twice or something to that effect so that the macro will continue running until the user is done, but your help definitely pointed me in the right direction. I appreciate it.

 

I didn't realize that MS no longer supports VBA either. Thats good to know. I appreciate the link. I guess I'm going to have to bite the bullet and begin Visual LISP or .NET as a newbie .

 

If you (or anyone willing to help) has some input as to how to make the routine below continue as long as the user wishes - please feel free to point me along the right path

 

Thank you again!

 

 
Option Explicit
Sub Example_GetSubEntity()
   Dim Object As Object
   Dim PickedPoint As Variant, TransMatrix As Variant, ContextData As Variant
   Dim MyStyle As String
   Dim MyWidth As Integer
   Dim i As Variant
   MyStyle = "STANDARD"
   MyWidth = 1#

   On Error GoTo NOT_ENTITY

TRYAGAIN:
   ThisDrawing.Utility.GetSubEntity Object, PickedPoint, TransMatrix, ContextData
           If Not Object.StyleName = MyStyle Then
           Object.StyleName = MyStyle
           Object.ScaleFactor = MyWidth
           End If
           Object.Update

   Exit Sub

NOT_ENTITY:
   If MsgBox("You have not selected an object.  Click OK to try again.", _
              vbOKCancel & vbInformation) = vbOK Then
       Resume TRYAGAIN
   End If
End Sub

[BlackBox]

You're welcome; happy to help.

 

Just a guess, but consider the 'Do...Loop', using the While keyword?

 

... Oleg knows _far_ more than I about this.

[TroutKing]

I think I can make a Do loop work with one or the other - either the "Until" or the "While" keyword. However, I do not know the proper syntax to say "until the user hits ENTER" twice or something similar.

 

I'm not very familiar with your work here but I agree with your insight on Oleg. He has helped me more that I could ever repay (if I wasn't a poor broke drafter) over the years. He is an awesome source of help as well as a friend

 

Thank you again

[fixo]

what the biggest trout you caught for these years?

e-mail me, I've forgot about

[TroutKing]

Ha! Fishing has not been very productive this year. Way too busy with my fourth child only 8 months old.

 

OK, with the help I received here and my other research and the beginning of a bald spot on the side of my head from scratching while thinking, I was able to get this to work. I'm not sure how stable it is but it works. If anyone want's to adjust it to make it better - please feel free! I don't get my feelings easily hurt from constructive critism! Just ask Oleg. I can't tell you how many times he has reached over the internet and thumped me in the head!

 

 
Option Explicit
Sub Example_GetSubEntity()
   Dim Object As Object
   Dim PickedPoint As Variant, TransMatrix As Variant, ContextData As Variant
   Dim MyStyle As String
   Dim MyWidth As Integer
   Dim i As Integer
   Dim REPLY As String
   MyStyle = "STANDARD"
   MyWidth = 1#

   On Error GoTo NOT_ENTITY

TRYAGAIN:
Do
   ThisDrawing.Utility.GetSubEntity Object, PickedPoint, TransMatrix, ContextData
           If Not Object.StyleName = MyStyle Then
           Object.StyleName = MyStyle
           Object.ScaleFactor = MyWidth
           End If
           Object.Update
Loop
   Exit Sub

NOT_ENTITY:
   REPLY = MsgBox("                   You have not selected an attribute" & vbCr & vbCr & "Press RETRY to continue or CANCEL to end the macro", vbRetryCancel, "                    A SPECIAL MESSAGE JUST FOR YOU")
   If REPLY = 4 Then
   Resume TRYAGAIN
   End If

End Sub

[fixo]

If you used 'Option Explicit' better yet to cast all object

explicitly, so you have to cast an object as AttributeReference

Set attRef = Object

then change its properties, you will be avoid many mistakes

in your code

I posted you another loop example, sorry, not tested

See you,