creating blocks in vba

Anonymous — Tue, 24 Nov 2009 10:05:40 GMT

First some background.
I have a vba project in which the user is asked to pick points on the screen and when done a userform opens from which the user selects options from combo/textboxes etc. these values are then passed across and a block is created and then inserted on the drawing. There may be many many instances required on the drawing which when extracted to excel create a bill of materials. This all works fine xcept i have needed to add a further attribute to the block which on new drawings all works fine but when the macro is used on a drawing which has the existing block in it it fails to create all the attributes although the block is inserted with blank attribute values in the block. Is there some way this can be overcome. I am new to vba and most of what i have done is through trial and error and with help from the discussion group members.

i do appreciate the help in the past and thank to all who take the time to help
johnb

below is the code from the create block section

Private Sub btnAddTendon_Click()
Dim objBlockDefinition As AcadBlock
Dim objBlockReference As AcadBlockReference
Dim varAttributes As Variant
Dim blnBlockExists As Boolean
Dim varInsertionPoint As Variant
Dim intIndex As Integer
Dim txtTotStrandLength As Variant
Dim txtTendonTonnage As Variant
Dim PI As Double
PI = Atn(1) * 4

If FormDataIsValid Then
Me.Hide

' Create the tendon block definition if it doesn't already exist.
blnBlockExists = False
For Each objBlockDefinition In ThisDrawing.Blocks
If objBlockDefinition.Name = TENDON_BLOCK_NAME Then
blnBlockExists = True
Exit For
End If
Next objBlockDefinition

If Not blnBlockExists Then
CreateTendonBlock
End If

'insert an instance of the tendon block in modelspace.
'select points for block rotation:
Dim Pt As Variant

Dim PtSel(0 To 2) As Double
Dim Bl_RotationAngle As Double
Dim ipang As Double

varInsertionPoint = ThisDrawing.Utility.GetPoint(, "select insertion point:")
Bl_RotationAngle = ThisDrawing.Utility.GetAngle(varInsertionPoint, "select point on tendon: ")

' You will see a rubber band from Pt to the cursor location.

' Set values of a point from the returned variant
PtSel(0) = varInsertionPoint(0)
PtSel(1) = varInsertionPoint(1)
Dim LayerObj As AcadLayer
Set LayerObj = ThisDrawing.Layers.Add("TendonID")

If Bl_RotationAngle > (PI / 2) Then
ipang = Bl_RotationAngle + PI
End If
If Bl_RotationAngle < (1.5 * PI) Then
ipang = Bl_RotationAngle + PI
End If

ThisDrawing.ActiveLayer = ThisDrawing.Layers("TendonID") 'objBlockDefinition.Layer = "TendonId"

Set objBlockReference = ThisDrawing.ModelSpace.InsertBlock(varInsertionPoint, _
TENDON_BLOCK_NAME, 1#, 1#, 1#, Bl_RotationAngle + (PI / 2#))
' Update the block ref's attributes.
varAttributes = objBlockReference.GetAttributes
For intIndex = LBound(varAttributes) To UBound(varAttributes)
Select Case varAttributes(intIndex).TagString
Case "Pour Number"
varAttributes(intIndex).TextString = TxtPourNumber.Text
Case "ID"
varAttributes(intIndex).TextString = txtTendonID.Text
varAttributes(intIndex).Rotation = 0#
Case "Strand Type"
varAttributes(intIndex).TextString = cboStrandType.Text
Case "No. Strands"
varAttributes(intIndex).TextString = cboNumberStrands.Text
varAttributes(intIndex).Rotation = ipang '+ PI ' / 2 '-1#)
Case "Duct Length"
varAttributes(intIndex).TextString = txtDuctLength.Text
Case "Tendon Length"
varAttributes(intIndex).TextString = txtTendonLength.Text
Case "TotStrandLength"
varAttributes(intIndex).TextString = getTotalStrandLength(txtTendonLength.Text, cboNumberStrands.Text)
Case "CASTING1"
varAttributes(intIndex).TextString = Txtcastingle1.Text
Case "ANCHOR1"
varAttributes(intIndex).TextString = Txtanchorblockle1.Text
Case "CASTING2"
varAttributes(intIndex).TextString = Txtcastingle2.Text
Case "ANCHOR2"
varAttributes(intIndex).TextString = Txtanchorblockle2.Text
Case "COUPLER"
varAttributes(intIndex).TextString = txtCouplingLE.Text
Case "1stend"
varAttributes(intIndex).TextString = Cbofirstend.Text
Case "2ndend"
varAttributes(intIndex).TextString = Cbosecondend.Text
Case "Tendon Tonnes"
varAttributes(intIndex).TextString = Format(tonnage, "#.###")
Case "Duct Size"
varAttributes(intIndex).TextString = Txtductsize.Text

End Select

Next intIndex
Unload Me
End If
End Sub

Re: creating blocks in vba

Anonymous — Wed, 25 Nov 2009 19:03:56 GMT

Hi,

The code you gave seems to be ok, the pb should be in you "CreateTendonBlock" or the code where you add the Attribute definition in the existing block:

This works for me :

Dim oAcadBlockRef As AcadBlockReference
Dim oAcadBlockDef As AcadBlock
Dim oAttribDef As AcadAttribute

'Get the existing block definition
Set oAcadBlockDef = ThisDrawing.Blocks(oAcadBlockRef.Name)
'Add the attribute...
Set oAttrib = oAcadBlockDef.AddAttribute(4, acAttributeModeNormal, "Message :", InsPoint, "TAG", "Value")
'Update the block reference
oAcadBlockRef.Update

Enjoy.

topic creating blocks in vba in VBA Forum

creating blocks in vba

Re: creating blocks in vba