从AUTOCAD获取字到excel

ARM 37浏览

在编写PLC程序的时候需要将每个点的名称输入到程序里面去,点数多的时候很费时间,而且很容易打错,考虑到这些点的名称在图纸上有,但是在图纸上只能一个一个的复制,不能一起复制,还是很浪费时间,有没有其他的办法呢?(本人比较懒,不想动手去打那些名字)后来想到可以利用AUTOCAD里面的宏来做完成,但是AUTOCAD的编程我不熟悉,于是在网上找了半天,终于让我找到一个半成品,它可以从AUTOCAD中获得字,然后输出到excel中去,但是它对于多行文字输出的字符串有乱码,并且顺序也不正确,好了,有这些就够了,剩下的我可以解决。首先要将excel控件加到VBA程序中来,修改之后的代码如下:

Private Type mystr

        str As String

        x As Double

        y As Double

End Type

 Sub TQ()

    On Error Resume Next

    Dim i As Integer

    Dim j As Integer

    Dim E As Excel.Application, B As Workbook, S As Worksheet

    Dim SS As AcadSelectionSet, T As Object, FT(3) As Integer, FD(3) As Variant

    Dim search As String

    Dim mstrcount As Integer

    Dim lengthstr As Integer

    Dim block(0 To 50) As Integer

    Dim seltext(0 To 255) As mystr

    Dim point As Variant

    Dim counter As Integer

    'Dim midnum As Double

    Dim midstr As mystr

    Dim cx As Integer

    Dim cy As Integer

    search = "pt1;"

    '下面定义选择集过滤器列表为多行文字或单行文字

    FT(0) = -4: FD(0) = "<or"

    FT(1) = 0: FD(1) = "mtext"

    FT(2) = 0: FD(2) = "text"

    FT(3) = -4: FD(3) = "or>"

    '创建选择集

    Set SS = ThisDrawing.SelectionSets.Add("SS")

    '在屏幕上选择多行文字或单行文字对象"

    SS.SelectOnScreen FT, FD

    '如果选择集不为空则运行以下代码

    If SS.Count > 0 Then

        '运行EXCEL程序

        Set E = New Excel.Application

        '在EXCEL中插入工作薄

        Set B = E.Workbooks.Add

        Set S = B.ActiveSheet

        '设置一列宽度

        S.Columns(1).ColumnWidth = 30

        '显示EXCEL程序

        E.Visible = True

        '把所有字符串及坐标保存起来

        For Each T In SS

            seltext(i).str = T.TextString

            point = T.InsertionPoint

            seltext(i).x = point(0)

            seltext(i).y = point(1)

            i = i + 1

        Next

        counter = i - 1

        '按坐标从上到下,从左到右的顺序排序

        '分段

        j = 0

        For i = 0 To counter - 1

            If Abs(seltext(i + 1).x - seltext(i).x) > 50 Then

                j = j + 1

                block(j) = i

                j = j + 1

                block(j) = i + 1

            End If

        Next

        block(j + 1) = counter

        '分段排序

        For i = 0 To j Step 2

            For cx = block(i) To block(i + 1) - 1

                For cy = block(i) To block(i + 1) - cx - 1 + block(i)

                    If seltext(cy).y < seltext(cy + 1).y Then

                        midstr = seltext(cy)

                        seltext(cy) = seltext(cy + 1)

                        seltext(cy + 1) = midstr

                    End If

                Next

            Next

        Next

         '把单行文字或多行文字的内容写入表格

        '对于多行文字,如果直接写入则字符串中很可能包含转义符,使用者可根据需要对字符串运算处理后再写入表格

        For i = 0 To counter

             mstrcount = InStr(1, seltext(i).str, search) '判断是否为多行文字

             If mstrcount > 0 Then

             lengthstr = Len(seltext(i).str)

             '去除多行文字前面多余的部分

             seltext(i).str = Right(seltext(i).str, lengthstr - 5)

             End If

              S.Cells(i + 1, 1).Value = seltext(i).str

         Next

    End If

    '删除用过的选择集

    SS.Delete

End Sub

使用的时候应用宏,然后按住shift选择你要转换的文字,然后点击右键就可以输出到excel中去了。