orientation of block and its multiple attributes

Anonymous — Mon, 10 Dec 2007 01:42:20 GMT

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.

Re: orientation of block and its multiple attributes

Anonymous — Mon, 10 Dec 2007 06:30:12 GMT

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'~

topic orientation of block and its multiple attributes in VBA Forum

orientation of block and its multiple attributes

Re: orientation of block and its multiple attributes