Need help converting regular text into an attribute and insert a block

[Anonymous]

I got some of this code from the help. Some of this code I had from other things I did years ago so it's probably not correct.

I am using AutoCAD 2000i BTW

I would like to click a button, hide the form, pick the text, I'm only picking one text item, then insert the picked text into a block. Then put the text into the attribute in the block

Insertion point of the block next to the text item.

-----------

Private Sub CommandButton2_Click()

frmGetData.Hide

    'Set sset = ThisDrawing.SelectionSets.Add("SS3")

    Set sset = ThisDrawing.PickfirstSelectionSet

    sset.SelectOnScreen

   'For Each ssobject In sset

        'msg = msg & vbCrLf & ssobject.ObjectName

    'Next ssobject

    'MsgBox "The Pickfirst selection set contains: " & msg

    'sset.SelectOnScreen

    ' get text from text entity

    ' insert block

    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "myBlock", 1#, 1#, 1#, 0)

    '  attributes for the block reference

    varAttributes = blockRefObj.GetAttributes

    varAttributes(0).TextString = textfromTextEntity

    blockRefObj.Update

' end block stuff

    'ThisDrawing.SelectionSets("SS3").Delete 'to delete the existing selection set

    frmGetData.Show

End sub

----------------------

TIA

[Hallex]

Try to adapt this code to your suit:

http://forums.autodesk.com/t5/Visual-Basic-Customization/Adding-attributes-to-existing-block-referen...

[Hallex]

Here is very quick and dirty example

Change it as you need

Option Explicit

Private Sub cmdSelect_Click()
            Dim oEnt As AcadEntity
            Dim oText As AcadText
            Dim oAttrib As AcadAttribute
            Dim oBlkRef As AcadBlockReference
            Dim oBlkDef As AcadBlock
            Dim ppt As Variant
  
            Me.Hide
           
            ThisDrawing.Utility.GetEntity oEnt, ppt, vbCrLf & "Select text:"
            If Not TypeOf oEnt Is AcadText Then
            MsgBox "You have to select single-line text only"
            Exit Sub
            End If
            Set oText = oEnt
            Me.TextBox1.Text = oText.TextString
            Set oEnt = Nothing
           
            ThisDrawing.Utility.GetEntity oEnt, ppt, vbCrLf & "Select block:"
             If Not TypeOf oEnt Is AcadBlockReference Then
            MsgBox "You have to select block reference text only"
            Exit Sub
            End If
           
            Set oBlkRef = oEnt
            Dim ins As Variant
            ins = oBlkRef.insertionPoint
            ins = ThisDrawing.Utility.TranslateCoordinates(ins, acUCS, acWorld, False)
            
            ppt = ThisDrawing.Utility.GetPoint(, vbCrLf & "Pick location point of attribute: ")
            ppt = ThisDrawing.Utility.TranslateCoordinates(ppt, acUCS, acWorld, False)
            Dim xgap As Double
            Dim ygap As Double
            xgap = CDbl(ppt(0)) - CDbl(ins(0))
            ygap = CDbl(ppt(1)) - CDbl(ins(1))
            Dim blkname As String
            blkname = oBlkRef.EffectiveName
            Dim aTag As String, aPrompt As String, aValue As String
            Me.TextBox2.Text = blkname
           
   
    Dim aHgt As Double
    Dim aMode As Long
    Dim ipt(0 To 2) As Double
   
    ' define the attribute definition
    aHgt = oText.height
    aMode = acAttributeModeVerify
    aPrompt = "My Prompt"
   
    aTag = "New Tag"
    aValue = "New Value"'<-- or set value from TextBox1.Text
    Set oBlkDef = ThisDrawing.Blocks(blkname)
    Dim orig As Variant
    orig = oBlkDef.origin'<-- already in WCS
    ipt(0) = CDbl(orig(0)) + xgap: ipt(1) = CDbl(orig(1)) + ygap: ipt(2) = 0
    ' add the attribute definition object in the block table record
    Set oAttrib = oBlkDef.AddAttribute(aHgt, aMode, aPrompt, ipt, aTag, aValue)
  
    ThisDrawing.SendCommand "_attsync N " & blkname & vbCr
           
     Unload Me
    
End Sub