Настройки поиска (Страница 1 из 3)

Imports System.IO
Imports Autodesk.AutoCAD.Interop.Common
Imports Autodesk.AutoCAD.Interop
Imports System.Runtime.InteropServices
Imports System
Imports System.Diagnostics
Imports System.ComponentModel
Imports System.Windows.Forms
Imports System.Collections.Generic
Imports System.Text
Imports System.Drawing
Imports System.Drawing.Printing

   Private Sub ToolStripMenuItem60_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripMenuItem60.Click
        On Error GoTo end_prg
        Dim AcadApp As AcadApplication = Nothing
        Dim Activdoc As AcadDocument = Nothing
        Dim objSelSet, sloj As Object
        Dim varAttributes, vardynamicblockproperties, vartext As Object
        Dim ss As New Process
        Dim ss1, ttt As Object
        Dim obj As AcadObject
        Dim varInsertionpoint, varAttributes1 As Object
        Dim objSelSet1, ima, l As Object
        Dim objpointer As AcadEntity
        Dim dxfInt(0 To 4) As Short, dxfType(0 To 4) As Object
        Dim objSelCol, objSelCol1 As AcadSelectionSets
        ttt = 0

        ss = Process.GetProcessesByName("acad")(0)
        ss1 = ss.Id
        AppActivate(ss1)
        AcadApp = DirectCast(Marshal.GetActiveObject(progIDstr), AcadApplication)
        Activdoc = AcadApp.ActiveDocument

        Dim style As AcadTextStyle ' создание текстового стиля
        Dim style1 As AcadTextStyles
        style1 = Activdoc.TextStyles
        For i = 0 To style1.Count - 1
            If style1(i).name = "GS-GOST2304" Then
                ttt = 1
            End If
        Next
        If ttt = 0 Then
            style = Activdoc.TextStyles.Add("GS-GOST2304")
            style.fontFile = "cs_gost2304.shx"
            style.Width = 0.8
            style.ObliqueAngle = 0
            style.Height = 0
        End If ' создание текстового стиля



        Dim AcadApp1 As AcadBlocks
        Dim elem As AcadBlock
        Dim elem1 As Object

        AcadApp1 = Activdoc.Blocks
        ProgressBar1.Visible = True
        ProgressBar1.Minimum = 0
        ProgressBar1.Maximum = AcadApp1.Count
        ProgressBar1.Value = 0
        ProgressBar1.Step = 1
        ProgressBar1.PerformStep()
        For i = 0 To AcadApp1.Count - 1
            ProgressBar1.PerformStep()
            elem = AcadApp1.Item(i)
            If elem.Name.Contains("*U") = True Or elem.Name = "*Model_Space" Or elem.Name = "*Paper_Space" Then
                For y = 0 To elem.Count - 1
                    elem1 = elem.Item(y)
                    If elem1.ObjectName = "AcDbMText" Then
                        Dim text As AcadMText
                        elem1.stylename = "GS-GOST2304"
                    End If

                If elem1.ObjectName = "AcDbText" Then
                elem1.stylename = "GS-GOST2304"
                elem1.ScaleFactor = 0.8
                elem1.ObliqueAngle = 0
            End If

            If elem.Name <> "*Model_Space" And elem.Name <> "*Paper_Space" Then
                If elem1.ObjectName = "AcDbAttributeDefinition" Then
                    elem1.stylename = "GS-GOST2304"
                    elem1.ScaleFactor = 0.8
                    elem1.ObliqueAngle = 0
                End If
            End If
        Next
            End If
        Next