orientation of block and its multiple attributes

orientation of block and its multiple attributes

Anonymous
Not applicable
326 Views
1 Reply
Message 1 of 2

orientation of block and its multiple attributes

Anonymous
Not applicable
I've got a block with four visible text attributes, when the block is inserted at the default of 0 degrees my VBA code will only show one of the attributes as intended and I retain other functionality as well like rotating the text string and altering its content, however when the block is inserted at another angle (90,180, or 270) my code won't work. Even though it identifies the block as rotated it won't suppress three of the four attributes as intended. The notion is to insert a multitude of these blocks at angles of 0,90,180 and 270 with the attributes modes set to invisible, then later, using a userform, set that mode to false and only display the attribute that corresponds to the orientation of the block. My code allows full comand of the attribute when the block inserted at default of 0, i.e. can change the content and rotation of the attribute, but I have no control of the attributes when the block is inserted at any other orientation. Any thoughts are greatly appreciated.
0 Likes
327 Views
1 Reply
Reply (1)
Message 2 of 2

Anonymous
Not applicable
Here is one from my very first experiences
This will not work with constant attributes

[code]
Option Explicit
' make sure you set 'Break on Unhadled Errors' in Tools->
' Option->General tab->Error Trapping field
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Sub FixRotAtt()
Dim oSpace As AcadBlock
Dim oblkRef As AcadBlockReference
Dim attVar() As AcadAttributeReference
Dim oAtt As AcadAttributeReference
Dim oEnt As AcadEntity
Dim blkName As String
Dim k As Integer
Dim varPt As Variant
Dim dblRot As Double

blkName = InputBox(Prompt:=vbCr & "Enter the block name: ", _
Title:="Insert Block(s)", Default:="MLR")

On Error GoTo Err_Control

With ThisDrawing

If .GetVariable("TILEMODE") = 1 Then
Set oSpace = .ModelSpace
Else
Set oSpace = .PaperSpace
End If

End With

While Not IsNull(varPt)

With ThisDrawing

varPt = .Utility.GetPoint(, vbCrLf & "Pick insertion point of block (or hit Enter to Exit): ")
dblRot = .Utility.GetAngle(varPt, vbCrLf & "Digitize the rotation angle:")

Set oblkRef = oSpace.InsertBlock(varPt, blkName, 1, 1, 1, dblRot)

attVar = oblkRef.GetAttributes

For k = 0 To UBound(attVar)
attVar(k).Rotation = 0
attVar(k).Update
Next k

oblkRef.Update

End With

Wend

Exit_Here:
Exit Sub

Err_Control:
If Err.Number <> 0 Then
If Err.Description Like "User input is a keyword" Then
MsgBox "Interrupted by user", vbInformation
Else
MsgBox Err.Description
End If
End If
Resume Exit_Here

End Sub
[/code]

~'J'~
0 Likes