Imports System.Runtime.InteropServices
Imports System.Reflection
Imports System.Globalization
Imports System.Collections

Public Class ReflectionCommands

    <System.Security.SuppressUnmanagedCodeSecurity()> _
    Public Shared Sub TestACAD(fname As String)

        Dim thisThread As System.Globalization.CultureInfo = System.Threading.Thread.CurrentThread.CurrentCulture
        thisThread = New System.Globalization.CultureInfo("en-US")
        Dim appProgID As String = "Autocad.Application"

        ' Получаем ссылку на интерфейс IDispatch
        Dim AcadType As Type = Type.GetTypeFromProgID(appProgID)

        ' Запускаем Acad
        Dim AcadApp As Object = Activator.CreateInstance(AcadType)
        Dim visargs() As Object = New Object(0) {}
        visargs(0) = True
        ' Делаем видимым окно приложения
        AcadApp.GetType().InvokeMember("Visible", BindingFlags.SetProperty, Nothing, AcadApp, visargs, Nothing)
        Dim AcadDocs As Object = AcadApp.GetType().InvokeMember( _
    "Documents", BindingFlags.GetProperty, Nothing, AcadApp, Nothing)

        ' Заносим в массив параметров имя файла
        Dim args() As Object = New Object(1) {}
        args(0) = fname
        args(1) = False 'read-only=false
        ' Пробуем открыть файл
        Dim AcDoc As Object = AcadDocs.GetType.InvokeMember( _
        "Open", BindingFlags.InvokeMethod, Nothing, AcadDocs, args, Nothing)
        Dim Util As Object = New Object
        Try
            ' Получаем ссылку на активный документ
            AcDoc = AcadApp.GetType.InvokeMember( _
        "ActiveDocument", BindingFlags.GetProperty, Nothing, AcadApp, Nothing, Nothing)
            ' Получаем ссылку на объект AcadUtility
            Util = AcDoc.GetType().InvokeMember("Utility", BindingFlags.GetProperty, Nothing, AcDoc, Nothing)
            ' Получаем ссылку на объект блока модели
            Dim oSpace As Object = _
            AcDoc.GetType.InvokeMember( _
            "ModelSpace", BindingFlags.GetProperty, Nothing, AcDoc, Nothing)

            ''****************************************************************************
            drawLineInObject(oSpace, 0.0, 0.0, 1.0, 0.0, "0")
            drawLineInObject(oSpace, 1.0, 0.0, 0.0, 1.0, "0")
            drawLineInObject(oSpace, 1.0, 1.0, -1.0, 0.0, "0")
            drawLineInObject(oSpace, 0.0, 1.0, 0.0, -1.0, "0")

            Dim cp(0 To 2) As Double
            For i = 0 To 2
                cp(i) = 0.5
            Next
            cp(2) = 0
            Dim circ As Object = DrawCircle(oSpace, cp, 0.5)

            ''****************************************************************************

            'Сохранение документа
            Dim closeargs() As Object = New Object(1) {}
            closeargs(0) = True
            ' Под тем же именем
            closeargs(1) = fname
            ' Пробуем закрыть документ
            '        AcDoc.GetType().InvokeMember( _
            '        "Close", BindingFlags.InvokeMethod, Nothing, AcDoc, closeargs, _
            'Nothing, System.Globalization.CultureInfo.CurrentCulture, Nothing
            ' Упрощенный синтаксис
            AcDoc.GetType().InvokeMember( _
                    "Close", BindingFlags.InvokeMethod, Nothing, AcDoc, closeargs)

            ' Пробуем закрыть приложение
            AcadApp.GetType().InvokeMember( _
            "Quit", BindingFlags.InvokeMethod, Nothing, AcadApp, Nothing)
            MsgBox("Done, check a drawing")

        Catch ex As System.Exception
            MsgBox("Error: " & ex.Message & vbLf & "Trace: " & ex.StackTrace)

        Finally
            'Очистка мусора

            ' Уничтожение объекта AcDoc.
            releaseObject(AcDoc)
            ' Уничтожение объекта AcadDocs.
            releaseObject(AcadDocs)
            ' Уничтожение объекта AcadApp.
            releaseObject(AcadApp)
            ' Вызываем сборщик мусора для немедленной очистки памяти
            GC.WaitForPendingFinalizers()
            GC.GetTotalMemory(True)
            GC.WaitForPendingFinalizers()
            GC.GetTotalMemory(True)

            releaseObject(AcDoc)
            ' Уничтожение объекта AcadDocs.
            releaseObject(AcadDocs)
            ' Уничтожение объекта AcadApp.
            releaseObject(AcadApp)
            ' Вызываем сборщик мусора для немедленной очистки памяти
            GC.WaitForPendingFinalizers()
            GC.GetTotalMemory(True)
            GC.WaitForPendingFinalizers()
            GC.GetTotalMemory(True)

            System.Threading.Thread.CurrentThread.CurrentUICulture = thisThread

        End Try

    End Sub
    Public Shared Sub releaseObject(ByVal obj As Object)
        Try
            System.Runtime.InteropServices.Marshal.FinalReleaseComObject(obj)
            obj = Nothing
        Catch ex As Exception
            obj = Nothing
        Finally
            GC.Collect()
        End Try
    End Sub

    Public Shared Function DrawCircle(ByVal oBlock As Object, ByVal p() As Double, ByVal rad As Double) As Object

        Dim args() As Object = New Object(1) {}
        args(0) = p
        args(1) = rad
        Dim oCirc As Object = oBlock.GetType.InvokeMember("AddCircle", BindingFlags.InvokeMethod, Nothing, oBlock, args)
        Dim norm() As Double = New Double() {0.0, 0.0, 1.0}
        oCirc.GetType().InvokeMember("Normal", BindingFlags.SetProperty, Nothing, oCirc, New Object() {norm})

        Return oCirc
    End Function


    Public Shared Function drawLineInObject(ByVal oBlock As Object, _
                          ByVal startX As Double, _
                          ByVal startY As Double, _
                          ByVal lenghtX As Double, _
                          ByVal lenghtY As Double, _
                          ByVal layer As String) As Object

        Dim begpRef() As Double = New Double(2) {}
        Dim endpRef() As Double = New Double(2) {}


        begpRef(0) = startX
        begpRef(1) = startY
        begpRef(2) = 0.0
        endpRef(0) = begpRef(0) + lenghtX
        endpRef(1) = begpRef(1) + lenghtY
        endpRef(2) = 0.0

        Dim pts() As Object = New Object(1) {}
        pts(0) = begpRef
        pts(1) = endpRef
        Dim oLine As Object = oBlock.GetType.InvokeMember("AddLine", BindingFlags.InvokeMethod, Nothing, oBlock, pts)
        oLine.GetType.InvokeMember("Layer", BindingFlags.SetProperty, Nothing, oLine, New Object() {layer})
        oLine.GetType.InvokeMember("Update", BindingFlags.InvokeMethod, Nothing, oLine, Nothing)

        Return oLine

    End Function

End Class