PDA

View Full Version : AutoCAD 2004 - How to get the TextStyle of an attribute



malik641
06-23-2006, 05:43 AM
Hey Guys,

I can't get this to give me the text style (like "Standard" or "Architectural")...what am I doing wrong?


Sub Block_Attrib_TextStyle()
On Error Resume Next
Dim objBRef As AcadBlockReference
Dim varAttribs As Variant
Dim intI As Integer
For Each objBRef In ThisDrawing.ActiveSelectionSet
If objBRef.HasAttributes And Not objBRef Is Nothing Then
varAttribs = objBRef.GetAttributes
For intI = LBound(varAttribs) To UBound(varAttribs)
Debug.Print varAttribs(intI).Layer
Debug.Print varAttribs(intI).TextStyle
Next intI
End If
Next objBRef
End Sub


Also, I only select the blocks with attributes BEFORE I run the code...I'm not sure how to get it to work if I select a bunch of stuff (blocks, lines, circles, etc) then run the code...:dunno If I do with this code above, it won't even find the blocks with attributes.

TIA

lucas
06-23-2006, 06:19 AM
Hi Joseph,
This is an example using selectionset. It actually selects all dimensions on the drawing and highlights the ones with text override. Might give you a clue on the text attributes too.

Do you use attributes to extract your bom to excel?


Sub ad_VerifyDims()
'This routine highlights dimensions with overrides.
'Demand load: -vbarun;ad_Utility.dvb!ad_VerifyDims;
Dim adDimension As AcadDimension
Dim adSS As AcadSelectionSet
Dim fType(0 To 1) As Integer, fData(0 To 1)
Dim adOverRideCount As Integer
adOverRideCount = 0

Set adSS = ThisDrawing.SelectionSets.Add("adSS")
If Err Then Set adSS = ThisDrawing.SelectionSets.Add("adSS")
adSS.Clear
fType(0) = 0: fData(0) = "DIMENSION": fType(1) = 100: fData(1) = "*"
adSS.Select acSelectionSetAll, , , fType, fData

For Each adDimension In adSS
If adDimension.TextOverride <> "" Then
adDimension.TextColor = acYellow
adOverRideCount = adOverRideCount + 1
End If
Next adDimension
ThisDrawing.Application.Update
MsgBox adOverRideCount & " dimension override(s) found..."
adSS.Delete
End Sub

lucas
06-23-2006, 06:20 AM
Here is the code to reset the dims to original:

Sub ad_VerifyDimsResetColor()
'This routine restores dimension colors highlighted by 'ad_VerifyDims'.
'Demand load: -vbarun;ad_Utility.dvb!ad_VerifyDimsResetColor;
Dim adDimension As AcadDimension
Dim adSS As AcadSelectionSet
Dim fType(0 To 1) As Integer, fData(0 To 1)
Dim adOverRideCount As Integer
Set adSS = ThisDrawing.SelectionSets.Add("adSS")
If Err Then Set adSS = ThisDrawing.SelectionSets.Add("adSS")
adSS.Clear
fType(0) = 0: fData(0) = "DIMENSION": fType(1) = 100: fData(1) = "*"
adSS.Select acSelectionSetAll, , , fType, fData

For Each adDimension In adSS
If adDimension.TextColor = acYellow Then
adDimension.TextColor = ThisDrawing.GetVariable("DimClrT")
End If
Next adDimension
ThisDrawing.Application.Update
adSS.Delete
End Sub

malik641
06-23-2006, 06:28 AM
Steve,

Thanks for the code, I'll test it out after work :thumb

Also, no I'm not sending it to excel. I'm working on a KB entry :yes You'll see what I'm going for when I have it finished!

Yeah! More KB's!!! There's like NONE in AutoCAD!!! I've got so many ideas!!!

lucas
06-23-2006, 06:32 AM
I think that attributes are different than text.....
go to draw-block-define attributes.
create several of them then group and block them...are you familiar with this process?

malik641
06-23-2006, 07:41 AM
Not entirely...I'm going to have to try it out when I get home.

Thanks Steve

Tommy
08-05-2006, 11:21 AM
Hey Joseph,
Don't know where you are on this but umm here I used you code
Sub Block_Attrib_TextStyle()
On Error Resume Next
Dim objBRef As AcadBlockReference
Dim varAttribs As Variant
Dim intI As Integer
For Each objBRef In ThisDrawing.ActiveSelectionSet
If objBRef.HasAttributes And Not objBRef Is Nothing Then
varAttribs = objBRef.GetAttributes
For intI = LBound(varAttribs) To UBound(varAttribs)
Debug.Print varAttribs(intI).Layer
Debug.Print varAttribs(intI).StyleName '<--
Next intI
End If
Next objBRef
End Sub

fixo
08-06-2006, 02:20 AM
Try this instead:

Sub Attrib_TextStyle()
Dim Blocks As AcadBlocks
Dim oBlock As AcadBlock
Dim objEnt As AcadEntity
Dim oAttDef As AcadAttribute
Dim bName As String

On Error GoTo what_a
Set Blocks = ThisDrawing.Blocks
For Each oBlock In Blocks
With oBlock
bName = .Name
If bName = "" Then Exit For
If oBlock.IsLayout = False And _
oBlock.IsXRef = False Then

Debug.Print "Block Name: " & bName
For Each objEnt In oBlock
If TypeOf objEnt Is AcadAttribute Then
Set oAttDef = objEnt
Debug.Print "Tag: " & oAttDef.TagString & vbNewLine & _
"Prompt: " & oAttDef.PromptString & vbNewLine & _
"Layer: " & oAttDef.Layer & vbNewLine & _
"TextStyle: " & oAttDef.StyleName
End If
Next
Debug.Print String(15, "_")
End If
End With
Next
what_a:
MsgBox Err.Description
End Sub


Fatty

~'J'~