Inserting a block in VBA

This seems like a simple problem but I can't get the block to insert in the current drawing. The block is created but it doesn't show up in my drawing. I have to manually insert it by using the insert "block" method. Also, I'm trying to attach the part reference, in Mechanical 2008, to the block while I'm creating it by using the send command ampartref but it's not working as well. Help!

'Combo Box for Panel Sizes
Private Sub UserForm_Activate()
cmbPanelWidth.AddItem "1'-0"""
cmbPanelWidth.AddItem "1'-0 1/2"""
cmbPanelWidth.AddItem "1'-1"""
cmbPanelWidth.AddItem "2'-0"""
cmbPanelLength.AddItem "10'-0"""
cmbPanelLength.AddItem "10'-0 1/2"""
cmbPanelLength.AddItem "10'-1"""
cmbPanelHeight.AddItem "6"""
cmbPanelHeight.AddItem "8"""
cmbPanelHeight.AddItem "10"""
cmbPanelHeight.AddItem "12"""

cmbProfile.AddItem "Wall (P+P)"
cmbProfile.AddItem "Wall = P+R"
cmbProfile.AddItem "Wall = R+R"
cmbProfile.AddItem "Wall = T+G"
cmbProfile.AddItem "Wall = T+P"
cmbProfile.AddItem "Wall = P+G"
cmbProfile.AddItem "Floor/Roof = K+G"
cmbProfile.AddItem "Floor/Roof = K+P"
cmbProfile.AddItem "Lintel = P+P"
cmbProfile.AddItem "Lintel = T+G"
cmbProfile.AddItem "Lintel = T+P"
cmbProfile.AddItem "Lintel = P+G"
cmbChamfer.AddItem "Yes"
cmbChamfer.AddItem "No"

End Sub


'Create Box
Private Sub cmdCreatePanel_Click()
Dim varPick As Variant
Dim dblLength As Double
Dim dblWidth As Double
Dim dblHeight As Double
Dim dblCenter(2) As Double
Dim objEnt As Acad3DSolid
Dim InsertionPoint As Variant
Dim gpartref As McadPartReference
Dim ProfileRef As AcadBlockReference
Dim attHeight As Double
Dim attMode As Long
Dim attTag As String
Dim attPrompt As String
Dim attValue As String
Dim attEnt(2) As Double
Dim ObjEntAtt As AcadAttribute
Dim ChamferRef As AcadBlockReference
Dim blockname As String
Dim objEnt1 As AcadBlock
Dim blockorigin(2) As Double

Me.Hide
'get the input from user
With ThisDrawing.Utility
.InitializeUserInput 1
varPick = .GetPoint(, vbCr & "Pick a corner point: ")
.InitializeUserInput 1 + 2 + 4, ""
dblLength = .DistanceToReal(cmbPanelLength.Text, acEngineering)
.InitializeUserInput 1 + 2 + 4, ""
dblWidth = .DistanceToReal(cmbPanelWidth.Text, acEngineering)
.InitializeUserInput 1 + 2 + 4, ""
dblHeight = .DistanceToReal(cmbPanelHeight.Text, acEngineering)

' Return the current value of the insertion point
InsertionPoint = varPick
'calculate center point from input
dblCenter(0) = CDbl(varPick(0)) + (dblLength / 2)
dblCenter(1) = CDbl(varPick(1)) + (dblWidth / 2)
dblCenter(2) = CDbl(varPick(2)) + (dblHeight / 2)
End With

'insert Panel Number Attribute
attHeight = 5
attMode = acAttributeModeNormal
attTag = "Panel_Number"
attPrompt = "Enter Panel Number"
attValue = "W2"
attEnt(0) = (dblCenter(0)) + (dblLength / 100)
attEnt(1) = (dblCenter(1))
attEnt(2) = (dblCenter(2)) + (dblHeight / 2)
'Create Panel
blockname = attValue
If "" = blockname Then Exit Sub
'Set origin point
blockorigin(0) = (varPick(0))
blockorigin(1) = (varPick(1))
blockorigin(2) = (varPick(2))
'Check if Panel exist
On Error Resume Next
Set objEnt1 = ThisDrawing.Blocks.Item(blockname)
If Not objEnt1 Is Nothing Then
MsgBox "Panel already exists!"

End If
'Create the Panel
Set objEnt1 = ThisDrawing.Blocks.Add(blockorigin, blockname)
'Entities that create Panel
objEnt1.AddBox dblCenter, dblLength, dblWidth, dblHeight
objEnt1.AddAttribute attHeight, attMode, attPrompt, attEnt, attTag, attValue
objEnt1.InsertBlock InsertionPoint, (cmbChamfer.Text), 1#, 1#, 1#, 0
objEnt1.InsertBlock InsertionPoint, (cmbProfile.Text), 1#, 1#, 1#, 0
ThisDrawing.SendCommand "_ampartref" & vbCr & InsertionPoint & vbCr

'Insert Panel
Dim newPanel As AcadBlockReference
Dim point As Variant, blk As String
point = InsertionPoint
blk = "blockname"
Set newPanel = ThisDrawing.ModelSpace.InsertBlock(pt, blk, 1#, 1#, 1#, 0#)

'update entity
newPanel.History = True
newPanel.Update
ThisDrawing.Regen ActiveViewport
Unload Me

End Sub

It appears the purpose of the routine is to define a block, add some geometry, attributes and additional nested blocks. I assume the routine then subsequently attempts to insert a block reference (to that newly created block) into Modelspace.

If that is true then a couple of details need attention:

[color="Red"]attValue[/color] = [color="Red"]"W2"[/color]
attEnt(0) = (dblCenter(0)) + (dblLength / 100)
attEnt(1) = (dblCenter(1))
attEnt(2) = (dblCenter(2)) + (dblHeight / 2)
'Create Panel
[color="Red"]blockname[/color] = [color="red"]attValue[/color]
. . . .
Set objEnt1 = ThisDrawing.Blocks.Add(blockorigin, [color="red"]blockname[/color])

Here a block is created named “W2”

[color="Lime"]point[/color] = InsertionPoint
[color="darkred"]blk[/color] = [color="DarkRed"]"blockname"[/color]
Set newPanel = ThisDrawing.ModelSpace.InsertBlock([color="SeaGreen"]pt[/color], [color="darkred"]blk[/color], 1#, 1#, 1#, 0#)

Here a reference is being made to a block of a different name “blockname”. Also, this refernce will have an insertion point at pt(unassigned), not point.

Additionally, is it possible to avoid the SendCommand by adding Autodesk SymBBAuto 2.0 Type Library to the VBAIDE Tools- References. Then an automated call could be made via:

Dim prtRef As McadPartReference
Set prtRef = ThisDrawing.ModelSpace.AddCustomObject("MCADPARTREFERENCE")

Hey!

Thanks for the relply. You are are correct. I'm creating a block with an attribute, geometry, part reference and additional blocks (symbols). Then I'm inserting it back into the same drawing. However the "attvalue = W2" is very important. The attvalue will determine the blockname. This important because it will assign the numbering sequence in the B.O.M. At some point, I need to make CAD count in order after W2 such as W3, W4, W5....... So right now "blockname" is important. I'm a little confused as to how to reinsert the block back into the drawing without assigning as a "newblock". I'm getting lost in my own code

Also, I have tried ampartref as you have displayed it but it still won't attach itself to the block. I need to have the part reference (ampartref) attach to the block before it is inserted back into the drawing.

I've sinced revised my code but I still get the same result. The block does not show up and Ampartref comes in at 0,0,0. It needs to attach itself to the block before it inserted back into the drawing and in the lower left corner of the block (InsertionPoint).

'Combo Box for Panel Sizes
Private Sub UserForm_Activate()
cmbPanelWidth.AddItem "1'-0"""
cmbPanelWidth.AddItem "1'-0 1/2"""
cmbPanelWidth.AddItem "1'-1"""
cmbPanelWidth.AddItem "2'-0"""
cmbPanelLength.AddItem "10'-0"""
cmbPanelLength.AddItem "10'-0 1/2"""
cmbPanelLength.AddItem "10'-1"""
cmbPanelHeight.AddItem "6"""
cmbPanelHeight.AddItem "8"""
cmbPanelHeight.AddItem "10"""
cmbPanelHeight.AddItem "12"""

cmbProfile.AddItem "Wall (P+P)"
cmbProfile.AddItem "Wall = P+R"
cmbProfile.AddItem "Wall = R+R"
cmbProfile.AddItem "Wall = T+G"
cmbProfile.AddItem "Wall = T+P"
cmbProfile.AddItem "Wall = P+G"
cmbProfile.AddItem "Floor/Roof = K+G"
cmbProfile.AddItem "Floor/Roof = K+P"
cmbProfile.AddItem "Lintel = P+P"
cmbProfile.AddItem "Lintel = T+G"
cmbProfile.AddItem "Lintel = T+P"
cmbProfile.AddItem "Lintel = P+G"
cmbChamfer.AddItem "Yes"
cmbChamfer.AddItem "No"

End Sub


'Create Box
Private Sub cmdCreatePanel_Click()
Dim varPick As Variant
Dim dblLength As Double
Dim dblWidth As Double
Dim dblHeight As Double
Dim dblCenter(2) As Double
Dim objEnt As Acad3DSolid
Dim InsertionPoint As Variant
Dim ProfileRef As AcadBlockReference
Dim attHeight As Double
Dim attMode As Long
Dim attTag As String
Dim attPrompt As String
Dim attValue As String
Dim attEnt(2) As Double
Dim ObjEntAtt As AcadAttribute
Dim ChamferRef As AcadBlockReference
Dim blockname As String
Dim objEnt1 As AcadBlock
Dim blockorigin(2) As Double
Dim amprtref As McadPartReference

Me.Hide
'get the input from user
With ThisDrawing.Utility
.InitializeUserInput 1
varPick = .GetPoint(, vbCr & "Pick a corner point: ")
.InitializeUserInput 1 + 2 + 4, ""
dblLength = .DistanceToReal(cmbPanelLength.Text, acEngineering)
.InitializeUserInput 1 + 2 + 4, ""
dblWidth = .DistanceToReal(cmbPanelWidth.Text, acEngineering)
.InitializeUserInput 1 + 2 + 4, ""
dblHeight = .DistanceToReal(cmbPanelHeight.Text, acEngineering)

' Return the current value of the insertion point
InsertionPoint = varPick
'calculate center point from input
dblCenter(0) = CDbl(varPick(0)) + (dblLength / 2)
dblCenter(1) = CDbl(varPick(1)) + (dblWidth / 2)
dblCenter(2) = CDbl(varPick(2)) + (dblHeight / 2)
End With

'insert Panel Number Attribute
attHeight = 5
attMode = acAttributeModeNormal
attTag = "Panel_Number"
attPrompt = "Enter Panel Number"
attValue = "W5"
attEnt(0) = (dblCenter(0)) + (dblLength / 100)
attEnt(1) = (dblCenter(1))
attEnt(2) = (dblCenter(2)) + (dblHeight / 2)
'Create Panel
blockname = attValue
If "" = blockname Then Exit Sub
'Set origin point
blockorigin(0) = (varPick(0))
blockorigin(1) = (varPick(1))
blockorigin(2) = (varPick(2))
'Check if Panel exist
On Error Resume Next
Set objEnt1 = ThisDrawing.Blocks.Item(blockname)
If Not objEnt1 Is Nothing Then
MsgBox "Panel already exists!"

End If
'Create the Panel
Set objEnt1 = ThisDrawing.Blocks.Add(blockorigin, blockname)

'Entities that create Panel
objEnt1.AddBox dblCenter, dblLength, dblWidth, dblHeight
objEnt1.AddAttribute attHeight, attMode, attPrompt, attEnt, attTag, attValue
objEnt1.InsertBlock InsertionPoint, (cmbChamfer.Text), 1#, 1#, 1#, 0
objEnt1.InsertBlock InsertionPoint, (cmbProfile.Text), 1#, 1#, 1#, 0
Set ampartref = ThisDrawing.ModelSpace.AddCustomObject("acmPartRef")
ampartref.AttachGeometry blockname, InsertionPoint

'Insert Panel
Set objEnt1 = ThisDrawing.ModelSpace.InsertBlock(InsertionPoint, blk, 1#, 1#, 1#, 0#)

'update entity
objEnt1.History = True
objEnt1.Update
ThisDrawing.Regen ActiveViewport
Unload Me

End Sub

If the issue of AmPartRef is set aside for the moment: Does this mod insert the block as desired?

(Note – I tested this without the userform so could only replicate the general code)

Private Sub cmdCreatePanel_Click()
Dim varPick As Variant
Dim dblLength As Double
Dim dblWidth As Double
Dim dblHeight As Double
Dim dblCenter(2) As Double
Dim objEnt As Acad3DSolid
Dim InsertionPoint As Variant
Dim ProfileRef As AcadBlockReference
Dim attHeight As Double
Dim attMode As Long
Dim attTag As String
Dim attPrompt As String
Dim attValue As String
Dim attEnt(2) As Double
Dim ObjEntAtt As AcadAttribute
Dim ChamferRef As AcadBlockReference
Dim blockname As String
Dim objEnt1 As AcadBlock
Dim blockorigin(2) As Double
Dim entRef As AcadBlockReference 'variable added

  Me.Hide
  'get the input from user
  With ThisDrawing.Utility
  .InitializeUserInput 1
  varPick = .GetPoint(, vbCr & "Pick a corner point: ")
  .InitializeUserInput 1 + 2 + 4, ""
  dblLength = .DistanceToReal(cmbPanelLength.Text, acEngineering)
  .InitializeUserInput 1 + 2 + 4, ""
  dblWidth = .DistanceToReal(cmbPanelWidth.Text, acEngineering)
  .InitializeUserInput 1 + 2 + 4, ""
  dblHeight = .DistanceToReal(cmbPanelHeight.Text, acEngineering)
   
  ' Return the current value of the insertion point
  InsertionPoint = varPick
  'calculate center point from input
  dblCenter(0) = CDbl(varPick(0)) + (dblLength / 2)
  dblCenter(1) = CDbl(varPick(1)) + (dblWidth / 2)
  dblCenter(2) = CDbl(varPick(2)) + (dblHeight / 2)
  End With
   
  'insert Panel Number Attribute
  attHeight = 5
  attMode = acAttributeModeNormal
  attTag = "Panel_Number"
  attPrompt = "Enter Panel Number"
  attValue = "W5"
  attEnt(0) = (dblCenter(0)) + (dblLength / 100)
  attEnt(1) = (dblCenter(1))
  attEnt(2) = (dblCenter(2)) + (dblHeight / 2)
  'Create Panel
  blockname = attValue
  If "" = blockname Then Exit Sub
  'Set origin point
  blockorigin(0) = (varPick(0))
  blockorigin(1) = (varPick(1))
  blockorigin(2) = (varPick(2))
  
  
  'Check if Panel exist
  On Error Resume Next
  Set objEnt1 = ThisDrawing.Blocks.Item(blockname)
  On Error GoTo 0
  If Not objEnt1 Is Nothing Then
     MsgBox "Panel already exists!"
     Exit Sub
  End If
  
  
  'Create the Panel
  Set objEnt1 = ThisDrawing.Blocks.Add(blockorigin, blockname)
   
  'Entities that create Panel
  objEnt1.AddBox dblCenter, dblLength, dblWidth, dblHeight
  objEnt1.AddAttribute attHeight, attMode, attPrompt, attEnt, attTag, attValue
  objEnt1.InsertBlock InsertionPoint, (cmbChamfer.Text), 1#, 1#, 1#, 0
  objEnt1.InsertBlock InsertionPoint, (cmbProfile.Text), 1#, 1#, 1#, 0
      
  'Insert Panel
  Set entRef = ThisDrawing.ModelSpace.InsertBlock(InsertionPoint, attValue, 1#, 1#, 1#, 0#)
  Unload Me

End Sub

Well, I got the program to insert the block into the drawing through this code. However, the ampartref will not attach itself to the block. Instead, I had to use the SendCommand in order to have the user attach it to the block. I would prefer to have it automatically inserted but at this point I'm not sure how to do it.

'Combo Box for Panel Sizes
Private Sub UserForm_Activate()
cmbPanelWidth.AddItem "1'-0"""
cmbPanelWidth.AddItem "1'-0 1/2"""
cmbPanelWidth.AddItem "1'-1"""
cmbPanelWidth.AddItem "2'-0"""
cmbPanelLength.AddItem "10'-0"""
cmbPanelLength.AddItem "10'-0 1/2"""
cmbPanelLength.AddItem "10'-1"""
cmbPanelHeight.AddItem "6"""
cmbPanelHeight.AddItem "8"""
cmbPanelHeight.AddItem "10"""
cmbPanelHeight.AddItem "12"""

cmbProfile.AddItem "Wall (P+P)"
cmbProfile.AddItem "Wall = P+R"
cmbProfile.AddItem "Wall = R+R"
cmbProfile.AddItem "Wall = T+G"
cmbProfile.AddItem "Wall = T+P"
cmbProfile.AddItem "Wall = P+G"
cmbProfile.AddItem "Floor/Roof = K+G"
cmbProfile.AddItem "Floor/Roof = K+P"
cmbProfile.AddItem "Lintel = P+P"
cmbProfile.AddItem "Lintel = T+G"
cmbProfile.AddItem "Lintel = T+P"
cmbProfile.AddItem "Lintel = P+G"
cmbChamfer.AddItem "Yes"
cmbChamfer.AddItem "No"

End Sub


'Create Box
Private Sub cmdCreatePanel_Click()
Dim varPick As Variant
Dim dblLength As Double
Dim dblWidth As Double
Dim dblHeight As Double
Dim dblCenter(2) As Double
Dim objEnt As Acad3DSolid
Dim InsertionPoint As Variant
Dim ProfileRef As AcadBlockReference
Dim attHeight As Double
Dim attMode As Long
Dim attTag As String
Dim attPrompt As String
Dim attValue As String
Dim attEnt(2) As Double
Dim ObjEntAtt As AcadAttribute
Dim ChamferRef As AcadBlockReference
Dim blockname As String
Dim objEnt1 As AcadBlock
Dim blockorigin(2) As Double


Me.Hide
'get the input from user
With ThisDrawing.Utility
.InitializeUserInput 1
varPick = .GetPoint(, vbCr & "Pick a corner point: ")
.InitializeUserInput 1 + 2 + 4, ""
dblLength = .DistanceToReal(cmbPanelLength.Text, acEngineering)
.InitializeUserInput 1 + 2 + 4, ""
dblWidth = .DistanceToReal(cmbPanelWidth.Text, acEngineering)
.InitializeUserInput 1 + 2 + 4, ""
dblHeight = .DistanceToReal(cmbPanelHeight.Text, acEngineering)

'calculate center point from input
dblCenter(0) = CDbl(varPick(0)) + (dblLength / 2)
dblCenter(1) = CDbl(varPick(1)) + (dblWidth / 2)
dblCenter(2) = CDbl(varPick(2)) + (dblHeight / 2)
End With

'insert Panel Number Attribute
attHeight = 5
attMode = acAttributeModeNormal
attTag = "Panel_Number"
attPrompt = "Enter Panel Number"
attValue = (blockname)
attEnt(0) = (dblCenter(0)) + (dblLength / 100)
attEnt(1) = (dblCenter(1))
attEnt(2) = (dblCenter(2)) + (dblHeight / 2)
'Create Panel
blockname = attValue
If "" = blockname Then Exit Sub

'Count Panels
Dim objCount As Integer
Dim I As Integer
blockname = ThisDrawing.ModelSpace.Count

'Set origin point
blockorigin(0) = (varPick(0))
blockorigin(1) = (varPick(1))
blockorigin(2) = (varPick(2))
'Create the Panel
Set objEnt1 = ThisDrawing.Blocks.Add(blockorigin, blockname)

'Entities that create Panel
objEnt1.AddBox dblCenter, dblLength, dblWidth, dblHeight
objEnt1.AddAttribute attHeight, attMode, attPrompt, attEnt, attTag, attValue
objEnt1.InsertBlock blockorigin, (cmbChamfer.Text), 1#, 1#, 1#, 0
objEnt1.InsertBlock blockorigin, (cmbProfile.Text), 1#, 1#, 1#, 0

'Insert Block
On Error Resume Next
Dim newblock As AcadBlockReference
pt = blockorigin
blk = blockname
Set newPanel = ThisDrawing.ModelSpace.InsertBlock(pt, blk, 1#, 1#, 1#, 0#)



'Update entity
On Error Resume Next
objEnt1.History = True
objEnt1.Update
ThisDrawing.Regen ActiveViewport
On Error Resume Next
ThisDrawing.SendCommand "_ampartref" & vbCr & "B" & vbCr
MsgBox "Select Panel " & blockname & " and Attach Data"


Unload Me

End Sub