Создание листа в чертеже

Помогите разобраться. Нужно  Создать лист  в чертеже необходимого формата, форматы лежат в  pc3 файле на сетевом диске.  вот код

Dim objLayout As AcadLayout
  Dim objLt As AcadLayout
  Dim objEnt As AcadObject
  Dim objNewLayout As AcadLayout
  Dim colLayOuts As AcadLayouts
  Dim objEntArray() As Object
  Dim intCnt As Integer
  Dim blnExists As Boolean
  Set colLayOuts = ThisDrawing.Layouts
  Dim aaa As String
  Dim a() As String
  Dim kol  As Integer
  'Dim aaa As String
  Dim PaperWid As Integer
  Dim PaperHeig As Integer
   
  Dim nameformn As String
   
   
  Dim PaperWidth As Double
  Dim PaperHeight As Double
   
   
   
''''' из ComboBox1.Text  выбираем  нужный формат листа
'If ComboBox1.Text <> "" Then   

  If ComboBox1.Text = "A0" Then nameformn = "&#192;0" And PaperWid = 841 And PaperHeig = 1189 Else

  If ComboBox1.Text = "A1H" Then PaperHeig = 594#
  PaperWid = 841#
  nameformn = "&#192;1"
 
  If ComboBox1.Text = "A1V" Then PaperWid = 594# And PaperHeig = 841# And nameformn = "&#192;1"
   
 
   
  'End If
 

'''''  из TextBox1.Text  берем название листа
If TextBox1.Text <> "" Then
strTo = TextBox1.Text
Else
MsgBox "&#194;&#226;&#229;&#228;&#232;&#242;&#229; &#237;&#224;&#232;&#236;&#229;&#237;&#238;&#226;&#224;&#237;&#232;&#229; &#235;&#232;&#241;&#242;&#224;!  "
End If
n = ThisDrawing.Layouts.count
ReDim a(0 To n - 1) As String
For i = 0 To ThisDrawing.Layouts.count - 1
a(i) = ThisDrawing.Layouts.Item(i).Name
kol = ThisDrawing.Layouts.Item(i).Block.count

If (a(i) <> "" And kol <> 0) Then strFrom = a(i)
'End If
Next
n = 0
 
  For Each objLayout In colLayOuts
    If objLayout.Name = "VBD LayOut" Then
      blnExists = True
      Exit For
    End If
  Next objLayout
  If Not blnExists Then
    Set objNewLayout = colLayOuts.Add(strTo)
   
  n = objNewLayout.Block.count
   
    Set objNewLayout = colLayOuts.Item(strFrom)
   
   ThisDrawing.CopyObjects objEntArray, objLayout.Block
    objNewLayout.CopyFrom objLayout   
   
    ReDim objEntArray(objLayout.Block.count - 1)
       For Each objEnt In objNewLayout.Block
      Set objEntArray(intCnt) = objEnt
      intCnt = intCnt + 1
    Next
''&#243;&#241;&#242;&#224;&#237;&#238;&#226;&#234;&#232; &#235;&#232;&#241;&#242;&#224;

ThisDrawing.CopyObjects objEntArray, objLayout.Block
оbjNewLayout.CopyFrom objLayout 
aaa = objNewLayout.ConfigName   

  objNewLayout.ConfigName = "formats.pc3"
   aaa = objNewLayout.ConfigName 
         
    aaa = objNewLayout.ConfigName
Dim oPlot As AcadPlot
Dim colName As New Collection
Dim colPlot As New Collection

 
 
    Call colName.Add(objNewLayout.Name)
   Call colPlot.Add("formats.pc3", objNewLayout.Name)

 
 
 
   pName = ComboBox1.Text
Formats= objNewLayout.GetCanonicalMediaNames
For Each element In formats
Namef = objNewLayout.GetLocaleMediaName(element)
If InStr(1, Namef, pName, vbTextCompare) = 1 Then
objNewLayout.CanonicalMediaName = element
End If
Next element
objNewLayout.PaperUnits = acMillimeters
objNewLayout.CanonicalMediaName = pName

End If

''********************
Проблемы  возникают  в   ReDim objEntArray(objLayout.Block.count - 1)
  количество блоков  равно 0
и как   все таки изменить формат  уже готового листа?