add attributes to block via vba and keep them readable

[comcu]

hi,

 

was hoping someone could help

 

i have some code below that lets the user select a block, then adds a attribute to the the block, the attribute is filled with the blocks name which is basically the part no. this all works well until the block has been mirrored in some way which changes the x, y or z scale form 1 to -1.

 

so if there is several blocks on the drawing the attribute is added and on the blocks that have not been mirrored the attribute is the correct way round but on the block that have been mirrored the attribute is either upside down or backwards, or both.

 

what i dont understand fully is if you add the attribute when there is only one block in the drawing which is not mirrored the attribute is fine and then you can start mirroring the block which in turns automatically changes the upside down and backward value, so why does it not do this when i run my vba program?

 

 

 

Public strMyBlockName As String

Sub SelSet_FindBlockName_StoreName()

   Dim MyBlockRef As AcadBlockReference
   Dim I As Double
   Dim MyoEnt As AcadEntity
   Dim MyAttTextStr As String


   On Error Resume Next
   ThisDrawing.SelectionSets("SelectBlock").Delete
   If Err Then Err.Clear
   With ThisDrawing.Utility
       '' create a new selectionset
       Set objSS = ThisDrawing.SelectionSets.Add("SelectBlock")

       '' let user select entities interactively
       objSS.SelectOnScreen

        'MyObjSS.SelectOnScreen FilterType, FilterData
        'MyObjSS.Select acSelectionSetAll 'FilterType, FilterData
       '' highlight the selected entities
       objSS.Highlight True
       
 
       
       
       '' pause for the user
       '.Prompt vbCr & objSS.Count & " entities selected"
       '.GetString False, vbLf & "Enter to continue "

       For Each MyoEnt In objSS
           If TypeOf MyoEnt Is AcadBlockReference Then
               Set MyBlockRef = MyoEnt
                     strMyBlockName = MyBlockRef.Name
                     
           End If
       Next
End With

    
                           MyOldBlockObjSS.Erase

      
     Call Add_Att
      
      
  End Sub


Sub Add_Att()
   
   
  ' This example creates an attribute definition in a block.
   ' It then inserts the block. Then it changes the prompt string
   ' of the attribute definition, and inserts the block again.
   
   Call MakeStringUppercase
   
   ' Create the block
   Dim blockobj As AcadBlock
   Dim insertionPnt1(0 To 2) As Double
   Dim insertionPnt2(0 To 2) As Double

  ' insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
   'Set blockObj = ThisDrawing.Blocks.Add(insertionPnt1, "SFG101")
   
   Set blockobj = ThisDrawing.Blocks.Add(insertionPnt1, strMyBlockName)
   


   ' Define the attribute definition
   Dim attributeObj As AcadAttribute
   Dim height As Double
   Dim mode As Integer
   Dim prompt As String
   Dim tag As String
   Dim value As String
   
   height = 5
   mode = acAttributeModeNormal

       
       tag1 = "Part_No"
       prompt1 = "What is the Part No?"
       value1 = strMyBlockName
       insertionPnt1(0) = 5#: insertionPnt1(1) = 5: insertionPnt1(2) = 0



   ' Create the attribute definition on the block
       Set attributeObj = blockobj.AddAttribute(height, mode, prompt1, insertionPnt1, tag1, value1)


           
           
           
   ThisDrawing.SendCommand "_ATTSYNC" & vbCr & "NAME" & vbCr & strMyBlockName & vbCr

'Call SelSet_FindBlockName_StoreName



  ' ZoomAll

End Sub

 

thanks in advance for any help.

 

Col

[SEANT]

Look at some of the code back in this thread. If you compare the MyBlockRef.XScaleFactor and .YScaleFactor to -1 then you could adjust the myvaratt(i).Backward and .UpsideDown properties.

 

http://www.cadtutor.net/forum/showthread.php?t=25352