автоматизация построения электрических схем(excel-autocad)

Sub ImportZwcadDocument(ByRef MainDoc As ZwcadDocument, ByVal pathFileImport As String, ByVal InsertPoint As ZwcadPoint, ByVal scalefactor As Double, ByRef TextRep() As String)

    Dim libDoc As ZwcadDocument
    Dim i, countDoc As Integer
    Dim OpenDoc As ZwcadDocument
    Dim exportFile As String
    Dim sset As ZwcadSelectionSet
    Dim importFile As String

    On Error GoTo ErrorHandler
    Set libDoc = ZwcadApplication.Documents.Open(pathFileImport) 'открываю тот самый библиотечный файл с заготовленным блоком
    ReplaceMtext libDoc, TextRep 'процедура замены текстовых элементов в блоке
    Set sset = libDoc.SelectionSets.Add("TEST")
    exportFile = Left(pathFileImport, Len(pathFileImport) - 4) 'задаю имя файла из которого экспортирую
    libDoc.Export exportFile, "DXF", sset
    importFile = exportFile + ".DXF"
    MainDoc.Activate 'активирую файл чертежа в который импортирую блок из библиотечного файла
    MainDoc.Import importFile, InsertPoint, scalefactor
    
    libDoc.Close False
    Kill (importFile)
        
    Exit Sub

ErrorHandler:
    MsgBox ("Error import!")
End Sub

Sub ReplaceMtext(ByVal Zcdocument As ZwcadDocument, ByRef TextReplace() As String)
    Dim TypeError As String
    
    On Error GoTo LabelError
    Dim ssetObj As ZwcadSelectionSet
    Dim objMText As ZwcadMText
    
    For Each ssetObj In Zcdocument.SelectionSets
        If ssetObj.Name = "SelectText" Then
           ssetObj.Delete
           Exit For
        End If
    Next
    
    Dim intDXF(3) As Integer
    Dim varVal(3) As Variant
    TypeError = "Error add selection SelectText!"
    Set ssetObj = Zcdocument.SelectionSets.Add("SelectText")
    ssetObj.Clear
    intDXF(0) = -4
    varVal(0) = "<OR"
    intDXF(1) = 0
    varVal(1) = "MTEXT"
    intDXF(2) = 0
    varVal(2) = "TEXT"
    intDXF(3) = -4
    varVal(3) = "OR>"
    
    Dim point1 As New ZwcadPoint
    Dim point2 As New ZwcadPoint
    TypeError = "Error select zcSelectionSetAll"
    ssetObj.Select zcSelectionSetAll, point1, point2, intDXF, varVal
                              
    Dim countItemSet, i As Integer
    countItemSet = ssetObj.Count
      
    i = 0
    For Each objMText In ssetObj
    ' меняем все текстовые элементы которые определил селект
        objMText.TextString = TextReplace(i) 'TextReplace()-ему я присваиваю значения ячеек(excel) с текстом для замены в библиотечном файле
        objMText.Update
        i = i + 1
    Next
    
    Zcdocument.Regen
    ssetObj.Delete
    Exit Sub
LabelError:
    MsgBox (TypeError)
End Sub

    ssetObj.Select zcSelectionSetAll, point1, point2, intDXF, varVal
  

Sub open_dwg()

nLength = Columns(1).CurrentRegion.Rows.Count
If nLength < 1 Then
    MsgBox ("нет данных")
End If
    
Dim s As String
Dim t As String
Dim ZwCAD As ZwcadApplication
Dim frame As ZwcadDocument
Dim frameMSpace As ZwcadModelSpace
Dim libDoc As ZwcadDocument
Dim str As String
Dim ssetObjDoc As ZwcadSelectionSet
Dim mode As ZcSelectionSetType
Dim corner1 As New ZwcadPoint
Dim corner2 As New ZwcadPoint
Dim retObjects As ZwcadSelectionSet
Dim InsertPoint As New ZwcadPoint
Dim scalefactor As Double
Dim blockFlag As Boolean
Dim allItemText() As String
Dim i As Integer
scalefactor = 1
    'Set ZwCAD = CreateObject("ZwCAD.Application")
        Set frame = ZwcadApplication.Documents.Open(ThisWorkbook.Path + "\lib\frame.dwg")
             nCounter = 4
Do While nCounter <= nLength '(1) цикл перебора ячеек где находятся имена библиотечных
        For nCounter = 4 To nLength
        blockFlag = False
        For x = 3 To 9
            s = Cells(nCounter, x)
                t = Cells(nCounter + 1, 3)
    If blockFlag Then' координатное разбиение, для определенного условия когда открывается и импортируются те самые одинаковые элементы из одного библиотечного файла на которых текст ставится из предъидушего импортируемого
        InsertPoint(0) = 0#: InsertPoint(1) = -67.4: InsertPoint(2) = 0#
        Else
        InsertPoint(0) = 0#: InsertPoint(1) = 0#: InsertPoint(2) = 0#
    End If
        
        str = ThisWorkbook.Path + "\lib\" + CStr(s) + ".dwg"
    
If s = "Шкаф РСУ" Then '(4)
    ReDim allItemText(6)
    allItemText(0) = errAttributeOne(CStr(Cells(nCounter, 13)), nCounter, 13)'присваиваю текст из екселя дя замены в блоке библиотечного файла
    allItemText(1) = errAttributeOne(CStr(Cells(nCounter, 11)), nCounter, 11)
    allItemText(2) = errAttributeOne(CStr(Cells(nCounter, 12)), nCounter, 12)
    allItemText(3) = errAttributeOne(CStr(Cells(nCounter, 10)), nCounter, 10)
    allItemText(4) = errAttributeOne(CStr(Cells(nCounter, 15)), nCounter, 15)
    allItemText(5) = errAttributeOne(CStr(Cells(nCounter, 16)), nCounter, 16)
    allItemText(6) = errAttributeOne(CStr(Cells(nCounter, 17)), nCounter, 17)

    ImportZwcadDocument frame, str, InsertPoint, scalefactor, allItemText

ElseIf s = "Датчик" Then
    allItemText(0) = errAttributeOne(CStr(Cells(nCounter, 19)), nCounter, 19)

    ImportZwcadDocument frame, str, InsertPoint, scalefactor, allItemText
    ' ну и так далее по следующим элементам    
End If '(4)

Next x
Next nCounter

Loop '(1)
'frame.SaveAs (ThisWorkbook.Path + "\dwg.dwg")
'ZwCAD.Quit
'Set ZwCAD = Nothing
End Sub