[_Valery_]

Собственно, создаю файл с VBScript, в нем вставляю в чертеж XRecord с информацией, но при выполнении вылетает ошибка, представленная на скриншоте ниже. Кто-нибудь может объяснить, почему так происходит, и что Автокаду не нравится в типе массива VBScript?

Код:

[Выделить все]

Option Explicit

Dim AutoCAD
Dim RecordTypes(0)
Dim Records(0)

Set AutoCAD = CreateObject ("AutoCAD.Application")

AutoCAD.Visible = true

AutoCAD.Documents.Open "D:\sketch.dwg", false

RecordTypes(0) = 1
Records(0) = "Test"

AutoCAD.ActiveDocument.Dictionaries.Add ("My")
AutoCAD.ActiveDocument.Dictionaries ("My").AddXRecord ("XRecord")
AutoCAD.ActiveDocument.Dictionaries ("My").GetObject("XRecord").SetXRecordData RecordTypes, Records

Попробовал для того же чертежа запустить внутренний автокадовский VBA-код:

Код:

[Выделить все]

Sub Test()

Dim RecordTypes(0) As Integer
Dim Records(0)

RecordTypes(0) = 1
Records(0) = "Test"

ThisDrawing.Dictionaries.Add ("My")
ThisDrawing.Dictionaries("My").AddXRecord ("XRecord")
ThisDrawing.Dictionaries("My").GetObject("XRecord").SetXRecordData RecordTypes, Records

End Sub

Он выполняется как положено, однако, если определить RecordTypes как RecordTypes(0) без Integer, то вылетает та же ошибка с недопустимым аргументом type в SetXRecordData.

Автокад 2007.

[Олег (jr.)]

Сообщение от _Valery_ Sub Test() Dim RecordTypes(0) As Integer Dim Records(0) RecordTypes(0) = 1 Records(0) = "Test" ThisDrawing.Dictionaries.Add ("My") ThisDrawing.Dictionaries("My").AddXRecord ("XRecord") ThisDrawing.Dictionaries("My").GetObject("XRecord").SetXRecordData RecordTypes, Records End Sub

See Help--> SetXData

Код:

[Выделить все]

RecordTypes(0) = 1000

~'J'~

[_Valery_]

Нужно именно XRecord.

[Олег (jr.)]

Сообщение от _Valery_ Нужно именно XRecord.

Люблю все по-простому, а то в Хэлпе просто ужос какой-то:

Код:

[Выделить все]

Option Explicit

Public Sub TestXrecord()

    Dim DwgDict As AcadDictionary
    
    Dim oEnt As AcadEntity
    
    Dim oSset As AcadSelectionSet
    
    Dim ItemXrec As AcadXRecord
    
    Dim item, rest, xtout, xvout, i

    On Error Resume Next

    Set DwgDict = ThisDrawing.Dictionaries.Add("MyDictionary")

    If Err Then

        Err.Clear

    End If

    On Error GoTo 0

    With DwgDict

        While .Count > 0

            .item(0).Delete

        Wend

    End With

    Set oSset = ThisDrawing.PickfirstSelectionSet

    oSset.Clear

    oSset.SelectOnScreen

    For Each oEnt In oSset

        Set ItemXrec = DwgDict.AddXRecord(oEnt.Handle)

        Dim curXrec As AcadXRecord

        Set curXrec = DwgDict.GetObject(oEnt.Handle)

        Dim xtype(1) As Integer

        xtype(0) = 1: xtype(1) = 1

        Dim xval(1) As Variant

        xval(0) = oEnt.Layer: xval(1) = oEnt.color

        curXrec.SetXRecordData xtype, xval

    Next oEnt

    For Each item In DwgDict

        item.GetXRecordData xtout, xvout

        For i = 0 To UBound(xtout)

            Debug.Print "Layer: " & xvout(0) & " <===> " & " Color: " & xvout(1)

        Next
    Next

End Sub

~'J'~

[_Valery_]

Олег (jr.), не то это, VBScript != VBA. В общем, понятно, что при работе с Автокадом, как с КОМ-сервером, при вызове методов GetXRecordData и SetXRecordData первым аргументом должен быть "array of shorts", а в VBScript присвоить тип элементам массива нельзя (или есть способы?), а при все массивы имеют тип "array of variants", что и не нравится Автокаду.

Может кто знает, как это решить?